home *** CD-ROM | disk | FTP | other *** search
Text File | 1994-01-31 | 94.3 KB | 2,948 lines |
- (*---------------------------------------------------------------------------
- :Program. MuchMore.mod
- :Author. Fridtjof Siebert
- :Address. Nobileweg 67, D-70439 Stuttgart, Germany
- :Shortcut. [fbs]
- :Copyright. Freeware
- :Language. Oberon-2
- :Translator. Amiga Oberon Compiler v3.01
- :History. V1.0 summer-88: First very slow internal version [fbs]
- :History. V1.1 24-Sep-88: First published version [fbs]
- :History. V1.2 26-Nov-88: Now displays Filelength & Percentage [fbs]
- :History. 27-Nov-88: Mouse can be used instead of Space/BackSpace [fbs]
- :History. V1.3 29-Apr-89: Strong increase in speed, removed WarpText [fbs]
- :History. 29-Apr-89: Now supports Numeric Keys (Home,PgUp etc.) [fbs]
- :History. 29-Apr-89: Now opens Screen as big as gfx.normalDisplay [fbs]
- :History. V1.4 29/30-Apr-89: Asynchronus loading/displaying. Very nice [fbs]
- :History. 30-Apr-89, 00:33: Removed bugs in Filelength & L-Command[fbs]
- :History. 30-Apr-89, 02:21: Added Find-Command [fbs]
- :History. 30-Apr-89, 10:30: Scrolling stops when window inactive [fbs]
- :History. 01-May-89: Allocates no more unneeded memory for text [fbs]
- :History. 07-May-89: Allocates even less memory now [fbs]
- :History. 14-May-89: Removed deadlock-bug with Find-Window [fbs]
- :History. V1.5 25-May-89: Added print feature [fbs]
- :History. 25-May-89: Removed all imports (apart from Arts) [fbs]
- :History. 26-May-89: inspired by J. Kupfer, I added nk 5 to quit [fbs]
- :History. 26-May-89: Now handle BS correctly [fbs]
- :History. V1.6 02-Jul-89: Now supports several fontstyles and colors [fbs]
- :History. V1.7 03-Jul-89: Is again as fast as it was with 2 colors [fbs]
- :History. 03-Jul-89: Now no more crashes when quitting while print[fbs]
- :History. 07-Jul-89: removed bug with texts of length 0 [fbs]
- :History. V1.8 10-Jul-89: small bug in find-command removed [fbs]
- :History. 10-Jul-89: now found strings are highlighted [fbs]
- :History. 14-Jul-89: nk0 to display fileinfo [fbs]
- :History. V2.0 06-Aug-89: Ported this to OBERON [fbs]
- :History. 06-Aug-89: Added ARP-FileRequester [fbs]
- :History. 07-Aug-89: Added L - (load new file) Command [fbs]
- :History. V2.1 03-Sep-89: no more gurus if an r/w error occures [fbs]
- :History. 03-Sep-89: MM used to execute CSI-Codes backwards. fixed[fbs]
- :History. 03-Sep-89: ping / pong with Shift+Fn / Fn [fbs]
- :History. 03-Sep-89: new command: goto [fbs]
- :History. V2.2 05-Sep-89: will run with any keymapping now [fbs]
- :History. V2.3 17-Sep-89: New command: sleep & Pop-Up feature [fbs]
- :History. 17-Sep-89: "MuchMore -s" will go to sleep immediately [fbs]
- :History. 17-Sep-89: Interprets <CSI>m as <CSI>0m now [fbs]
- :History. V2.4 17-Sep-89: New command: write block "w" [fbs]
- :History. 17-Sep-89: rewritten argument parser to allow quotes [fbs]
- :History. V2.5 18-Sep-89: now uses the 8x8 font set with SetFont [fbs]
- :History. 19-Sep-89: no more scatters memory. Allocates 4K Chunks [fbs]
- :History. V2.6 26-Jun-90: Made MuchMore reentrant [fbs]
- :History. 26-Jun-90: Opens 1-Plane Screen if memory is rare [fbs]
- :History. 26-Jun-90: Asynchronus fast scrolling with Ctrl-Up/Down [fbs]
- :History. 26-Jun-90: Now supports interlaced screens [fbs]
- :History. 08-Aug-90: CLI-Option '-l' to toggle interlaced mode [fbs]
- :History. V2.7 09-Aug-90: no more RethinkDisplay()s,looks good with 2.0[fbs]
- :History. 10-Aug-90: Supports Kick2.0 ASL-FileRequester [fbs]
- :History. V2.8 26-Dez-90: Leaves space between lines on interl. scrns [fbs]
- :History. V3.0 04-Jul-91: Supports any non-proportional font now [fbs]
- :History. 04-Jul-91: no more supports '-s' (sleep),was rarely used[fbs]
- :History. 04-Jul-91: new Options -f<font> and -s<size> for font [fbs]
- :History. 09-Nov-91: Find works w/ dmouse(window may get inactive)[fbs]
- :History. V3.1 04-Sep-92: Uses Screenmode of Workbench screen [fbs]
- :History. V3.2 02-Nov-92: Supports non-scrollable screens [fbs]
- :History. 02-Nov-92: Complete redraw doesn't scroll anymore [fbs]
- :History. V3.2.1 24-Dec-92: XPK Support (C.Stiens)
- :History. 24-Dec-92: New option -p for Password (C.Stiens)
- :History. 24-Dec-92: New option -e for Extra Spacing (C.Stiens)
- :History. 24-Dec-92: New option -c for Screen Colors (C.Stiens)
- :History. 24-Dec-92: Tooltypes (C.Stiens)
- :History. V3.2.2 08-Jan-93: Doesn't use MyMakeScreen() no more (C.Stiens)
- :History. V3.2.3 08-Feb-93: Now closes Console Device (C.Stiens)
- :History. 08-Feb-93: Non-Scroll Mode didn't work always (C.Stiens)
- :History. 10-Feb-93: ScreenMode Requester (C.Stiens)
- :History. 10-Feb-93: New Option -s for Scroll Mode (C.Stiens)
- :History. 10-Feb-93: Busy Pointer (C.Stiens)
- :History. 14-Feb-93: Now evals Tooltypes also on CLI start (C.Stiens)
- :History. V3.2.4 15-Feb-93: Clears Idcmp while Busy (C.Stiens)
- :History. 15-Feb-93: Bugs in GetString fixed (C.Stiens)
- :History. 19-Feb-93: More Scrollmodes (C.Stiens)
- :History. 20-Feb-93: Bug in Type() fixed (C.Stiens)
- :History. V3.2.5 08-Mar-93: Asynch Scrolling changed (C.Stiens)
- :History. 08-Mar-93: New Option -t for Taskpri (C.Stiens)
- :History. 10-Mar-93: Now uses Dos.ReadArgs if KS 2.04 (C.Stiens)
- :History. V3.2.6 19-Mar-93: scrollmode 3 now also scrolls soft (C.Stiens)
- :History. 19-Mar-93: New Option -o for one plane (C.Stiens)
- :History. 19-Mar-93: New Option -a for tab width (C.Stiens)
- :History. 19-Mar-93: Removed QText (C.Stiens)
- :History. 21-Mar-93: Opens screen with full overscan width (C.Stiens)
- :History. 22-Mar-93: Filename can be on any pos at KS1.3 (C.Stiens)
- :History. 27-Mar-93: New Option N=NOOSCAN (C.Stiens)
- :History. V3.2.7 07-Apr-93: Dont pokes to bitmap no more (C.Stiens)
- :History. V3.2.8 12-Apr-93: New Option B=PLANES (C.Stiens)
- :History. V3.2.9 12-May-93: Implemented V36 ANSI Codes (C.Stiens)
- :History. 3.2.10 16-May-93: Locale Support (C.Stiens)
- :History. 16-May-93: DispMode-Requester font-sensitive (C.Stiens)
- :History. V3.3 21-Jun-93: Code optimised (C.Stiens)
- :History. 25-Jun-93: Safe quit (C.Stiens)
- :History. V3.4 29-Jun-93: Clipboard support (C.Stiens)
- :History. 29-Jun-93: took version number out of catalog (C.Stiens)
- :History. V3.5 31-Jul-93: case sensitive search, Boyer-Moore Alg. (C.Stiens)
- :History. V3.6 15-Aug-93: Page up/down with softscroll reimpl. (C.Stiens)
- :History. 16-Aug-93: Flash at EOF/BOF (C.Stiens)
- :History. V3.7 28-Oct-93: New option E=EDITOR (C.Stiens)
- :History. 21-Nov-93: MM was not 100% pure (BusyPointer) (C.Stiens)
- :History. 21-Nov-93: Password has to be entered in stringgad (C.Stiens)
- :History. V4.0 07-Dec-93: MM can run in a WB Window (C.Stiens)
- :History. 07-Dec-93: Options WINDOW, LEFT, TOP, WIDTH, HEIGHT(C.Stiens)
- :History. 07-Dec-93: Kick 1.3 is no more supported (C.Stiens)
- :History. 07-Dec-93: Removed Options SCROLLMODE and NOOSCAN (C.Stiens)
- :History. V4.1 05-Jan-94: Prefs BusyPointer, set rp.mask or MaxPen(C.Stiens)
- :History. 10-Jan-94: Pipe Support, new option PUBSCREEN (C.Stiens)
- :History. 12-Jan-94: Option SCROLLMODE reintroduced (C.Stiens)
- :History. 12-Jan-94: New Option I=INTERLEAVED (C.Stiens)
- :History. V4.2 29-Jan-94: Zoom Gadget (v39) (C.Stiens)
- :History. 29-Jan-94: Better test for Pipe (C.Stiens)
- :History. 30-Jan-94: Icon is found if MM is started w/path (C.Stiens)
- :History. 31-Jan-94: New option FASTQUIT (C.Stiens)
- :History. 31-Jan-94: ShowTask allocates his signals now (C.Stiens)
- :Contents. A Soft-Scrolling ASCII-File Viewer.
- :Remark. Compile: 'Oberon -svbcrntzdma MuchMore' for short code
- :Remark. Compile: 'Oberon -dma MuchMore' for safe code
- :Remark. Link: 'OLink -dma MuchMore'
- ---------------------------------------------------------------------------*)
-
- MODULE MuchMore; (* $StackChk- *)
-
- IMPORT gt := GadTools,
- loc:= Locale,
- ip := IFFParse,
- u := Utility,
- con:= Console,
- str:= Strings,
- ie := InputEvent,
- I := Intuition,
- g := Graphics,
- d := Dos,
- e := Exec,
- ol := OberonLib,
- (* $IF quiet *) NoRequesters, (* $END *)
- SYS:= SYSTEM;
-
- CONST
- MuchText = "MuchMore 4.2 © 1988-94 AMOK\o$VER: muchmore 4.2 (31.1.94)";
- Version = "v4.2";
-
- MSGOOM = 0;
- MSGCOS = 1;
- MSGCOW = 2;
- MSGCOF = 3;
- MSGRWERR = 4;
- MSGRETRYABORT = 5;
- MSGEMPTY = 6;
- MSGSAVE = 7;
- MSGUSE = 8;
- MSGCANCEL = 9;
- MSGOK = 10;
- MSGCHOOSESM = 11;
- MSGINFOFMT = 12;
- MSGH1 = 13;
- MSGH2 = 14;
- MSGH3 = 15;
- MSGH4 = 16;
- MSGH5 = 17;
- MSGH6 = 18;
- MSGH7 = 19;
- MSGH8 = 20;
- MSGH9 = 21;
- MSGH10 = 22;
- MSGH11 = 23;
- MSGH12 = 24;
- MSGH13 = 25;
- MSGH14 = 26;
- MSGH15 = 27;
- MSGH16 = 28;
- MSGH17 = 29;
- MSGH18 = 30;
- MSGH19 = 31;
- MSGH20 = 32;
- MSGH21 = 33;
- MSGH22 = 34;
- MSGH23 = 35;
- MSGH24 = 36;
-
-
- TYPE
- MSGTYPE = ARRAY 37 OF e.STRPTR;
-
- CONST
-
- MSGS = MSGTYPE(
- SYS.ADR( "Out of memory" ),
- SYS.ADR( "Can't open screen" ),
- SYS.ADR( "Can't open window" ),
- SYS.ADR( "Can't open file" ),
- SYS.ADR( "Read/Write Error" ),
- SYS.ADR( "Retry|Abort" ),
- SYS.ADR( "File empty" ),
- SYS.ADR( "Save" ),
- SYS.ADR( "Use" ),
- SYS.ADR( "Cancel" ),
- SYS.ADR( " OK " ),
- SYS.ADR( "Choose Screen Mode:"),
- SYS.ADR( " File: %-30.30s %ld%% (%ld of %ld Bytes) %ld Lines"),
- SYS.ADR( "\x13 \x15 MuchMore %s Commands: "),
- SYS.ADR( " \x0dSpace\x05,\x0d LMB\x05: Start / Stop scrolling, Quit at end of file"),
- SYS.ADR( " \x0dBackSpace\x05,\x0d RMB\x05: Start / Stop scrolling backwards"),
- SYS.ADR( " \x0dUp\x05/\x0dDown\x05: Move one line \x0dup\x05 or \x0ddown\x05"),
- SYS.ADR( " \x0dShift \x05+\x0d Up\x05/\x0dDn\x05: Start / Stop quick scrolling \x0dup\x05 or \x0ddown\x05"),
- SYS.ADR( " \x0dControl\x05: Increase scroll speed"),
- SYS.ADR( " \x0dAlt\x05+\x0dUp\x05/\x0dDn\x05,\x0d PgUp\x05/\x0dDn\x05: Move one page \x0dup\x05 or \x0ddown\x05"),
- SYS.ADR( " \x0dT\x05,\x0d Home \x05/\x0d B\x05,\x0d End\x05: Goto \x0dt\x05op / \x0db\x05ottom of text"),
- SYS.ADR( " (\x0DShift\x05) \x0DF\x05, \x0DN\x05, \x0DP\x05: \x0DF\x05ind string (case sensitive), \x0DN\x05ext, \x0DP\x05revious"),
- SYS.ADR( " \x0dShift \x05+\x0d Fn\x05: Set textmarker #n to current position"),
- SYS.ADR( " \x0dFn\x05: Goto marker #n or set marker #n if it wasn't set yet"),
- SYS.ADR( " \x0dG\x05: \x0dG\x05oto line..."),
- SYS.ADR( " \x0dNK 0\x05: Display info line"),
- SYS.ADR( " \x0dShift \x05+\x0d Alt \x05+\x0d O\x05: Print text"),
- SYS.ADR( " \x0dW\x05: \x0dW\x05rite block between marker #1 and #2 to file or prt"),
- SYS.ADR( " \x0dL\x05: \x0dL\x05oad new text"),
- SYS.ADR( " \x0dHELP\x05,\x0d H\x05: Show commands"),
- SYS.ADR( " \x0dESC\x05,\x0d Q\x05,\x0d X\x05,\x0d NK 5\x05:\x0d Q\x05uit"),
- SYS.ADR( "© \x131988-94 Fridtjof Siebert & Christian Stiens"),
- SYS.ADR( ""),
- SYS.ADR( " \x13Please refer to MuchMore.doc for a detailed copyright notice"),
- SYS.ADR( " This is another product of the Amiga MODULA & OBERON Klub Stuttgart - \x0d\x13AMOK"),
- SYS.ADR( " \x0dC\x05: \x0dC\x05opy block between marker #1 and #2 to clipboard"),
- SYS.ADR( " \x0dShift \x05+\x0d Alt \x05+\x0d E\x05: \x0dE\x05dit text") );
-
-
-
- TYPE BusyPointer = ARRAY 36 OF INTEGER;
-
- CONST TheBusyPointer = BusyPointer(
- 00000U,00000U,
- 00400U,007C0U, 00000U,007C0U, 00100U,00380U, 00000U,007E0U,
- 007C0U,01FF8U, 01FF0U,03FECU, 03FF8U,07FDEU, 03FF8U,07FBEU,
- 07FFCU,0FF7FU, 07EFCU,0FFFFU, 07FFCU,0FFFFU, 03FF8U,07FFEU,
- 03FF8U,07FFEU, 01FF0U,03FFCU, 007C0U,01FF8U, 00000U,007E0U,
- 00000U,00000U);
-
-
- CONST (* RawKey Codes: *)
-
- ESC = 45H; HELP = 5FH;
- UP = 4CH; DOWN = 4DH;
- SPACE = 40H; BS = 41H;
- CR = 44H; ENTER = 43H;
- NK0 = 0FH; NK1 = 1DH; NK2 = 1EH; NK3 = 1FH;
- NK5 = 2EH; NK7 = 3DH; NK8 = 3EH; NK9 = 3FH;
- F1 = 50H; F10 = 59H;
-
-
- CONST
- ShowStackSize = 4096;
- BufferSize = 2048;
-
- w = TRUE;
- f = FALSE;
-
- MyIdcmp = LONGSET{I.rawKey,I.mouseButtons,I.closeWindow,I.activeWindow,I.inactiveWindow,I.newSize};
-
- (* Control codes: *)
- plain = 11X;
- italic = 12X;
- bold = 13X;
- boldit = 14X;
- ulineon = 15X;
- ulineoff = 16X;
-
- Italic = 0;
- Bold = 1;
- Ulin = 2;
- Inv = 3;
-
- TYPE
- String = e.STRING;
- StringPtr = e.STRPTR;
- CharPtr = UNTRACED POINTER TO CHAR;
- LongPtr = UNTRACED POINTER TO LONGINT;
-
- TextLinePtr = UNTRACED POINTER TO TextLine;
- TextLine = STRUCT
- prev : TextLinePtr;
- next : TextLinePtr;
- len : INTEGER;
- size : INTEGER;
- text : String;
- END;
-
- CONST
- MaxLen = SIZE(String);
-
- TYPE
-
- WBStartupPtr = UNTRACED POINTER TO STRUCT (message : e.Message)
- process : d.ProcessId;
- segment : e.BPTR;
- numArgs : LONGINT;
- toolWindow : StringPtr;
- argList : UNTRACED POINTER TO ARRAY 256 OF STRUCT
- lock : d.FileLockPtr;
- name : StringPtr;
- END;
- END;
-
- DiskObjectPtr = UNTRACED POINTER TO STRUCT
- magic : INTEGER;
- version : INTEGER;
- gadget : I.Gadget;
- type : SHORTINT;
- defaultTool: StringPtr;
- toolTypes : e.APTR;
- currentX : LONGINT;
- currentY : LONGINT;
- drawerData : e.APTR;
- toolWindow : StringPtr;
- stackSize : LONGINT;
- END;
-
- Args = STRUCT (dummy: d.ArgsStruct)
- b : LongPtr;
- c : StringPtr;
- d : StringPtr;
- e : StringPtr;
- f : StringPtr;
- i : StringPtr;
- o : StringPtr;
- p : LongPtr;
- q : StringPtr;
- s : LongPtr;
- t : LongPtr;
- u : StringPtr;
- x : LongPtr;
- w : StringPtr;
- wl : LongPtr;
- wt : LongPtr;
- ww : LongPtr;
- wh : LongPtr;
- file : StringPtr;
- END;
-
- (*------ Memory: ------*)
-
- CONST ChunkSize = 16384; (* size of allocated chunks *)
-
- TYPE
- MemChunkPtr = UNTRACED POINTER TO MemChunk; (* chunklist *)
-
- MemChunk = STRUCT
- prev: MemChunkPtr; (* link *)
- data: ARRAY ChunkSize OF CHAR; (* ChunkSize Bytes of memory *)
- END;
-
-
- (*------ Globals ------*)
-
- VAR
- pub : I.ScreenPtr; (* default public screen *)
- Screen : I.ScreenPtr; (* MuchMore's Screen *)
- Window : I.WindowPtr; (* MuchMore's Window *)
- rp : g.RastPortPtr; (* Screen's RastPort *)
- BM : g.BitMapPtr; (* Screen's BitMap *)
- id : LONGINT; (* Display ID *)
- catalog : loc.CatalogPtr; (* The Catalog *)
- MyFile : d.FileHandlePtr; (* For loading Textfile *)
- MyAttr : g.TextAttr; (* The selected Font attributes *)
- MyFont : g.TextFontPtr; (* The selected Font *)
- FontName : String; (* My Font Name or *)
- FontSize : INTEGER; (* My Font Size *)
- FirstLine : TextLinePtr; (* the topmost Line *)
- TopLine : TextLinePtr; (* the topmost Line *)
- BottomLine : TextLinePtr; (* Last Line displayed on Screen *)
- LoadLine : TextLinePtr; (* currently loaded Line *)
- LastLine : TextLinePtr; (* Last element of LineList *)
- writeText : TextLine; (* temp. Text Line *)
- Name,OldName : String; (* Text's Name *)
- option : String; (* CLI Option *)
- pubscreenname : String;
- zoomBox : ARRAY 4 OF INTEGER;
- editcmd : String;
- Pens : String; (* Screen colors *)
- Cols : ARRAY 4 OF INTEGER; (* Color array for LoadRGB4 *)
- busyPointer : UNTRACED POINTER TO BusyPointer;
- icon : DiskObjectPtr; (* info *)
- nameptr : StringPtr; (* String Pointer *)
- chptr : CharPtr; (* Char Pointer *)
- PStr : String; (* The command for Dos.Execute *)
- Buffer : UNTRACED POINTER TO ARRAY BufferSize OF CHAR; (* ReadBuf *)
- RQPos : LONGINT; (* Position within ReadBuffer *)
- RQLen : LONGINT; (* Number of CHARs in Buffer *)
- AnzLines : LONGINT; (* Length of Text in Lines *)
- NumLines : INTEGER; (* Number of Lines on Screen *)
- fontWidth,fontHeight: INTEGER; (* Font size *)
- fontBaseLine : INTEGER; (* Font base line *)
- spacing : INTEGER; (* Extra Line Spacing *)
- NumColumns : INTEGER; (* Number of Columns on Screen *)
- PageHeight : INTEGER; (* fontHeight*NumLines *)
- i,j : INTEGER; (* count *)
- left,top : INTEGER; (* Dimensions of MMs window *)
- width,height : INTEGER;
- initialheight : INTEGER;
- depth : INTEGER; (* Number of planes *)
- ci : INTEGER; (* Color index *)
- scrollmode : INTEGER; (* The scrollmode *)
- taskpri,oldpri : SHORTINT; (* Muchmore's Task Priority *)
- MyLock,OldDir : d.FileLockPtr; (* To Examine and Load File *)
- oldcd : d.FileLockPtr; (* To save old CD *)
- progdir : d.FileLockPtr; (* Lock on PROGDIR: *)
- clock : d.FileLockPtr; (* Lock on C: *)
- FileInfo : d.FileInfoBlockPtr; (* to get File's length *)
- FileLength,TextLength : LONGINT; (* Length of File and Displayed Text *)
- ReadLength : LONGINT; (* Length of Text while reading *)
- ScreenPos : INTEGER; (* actual position within bitmap *)
- ShowTask : e.TaskPtr; (* the task that displays the text *)
- ShowStack : e.APTR; (* it's stack *)
- ShowTaskRunning: BOOLEAN; (* is Showtask activated? *)
- win : BOOLEAN; (* Is MM running in a window? *)
- interleaved : BOOLEAN; (* Use interleaved Screen? *)
- zoomed : BOOLEAN; (* Is MM iconified ? *)
- stdin : BOOLEAN; (* Are we reading from STDIN ? *)
- SignalNewData : BOOLEAN; (* Signal when new data is loaded *)
- SignalAllRead : BOOLEAN; (* send signal at end of text *)
- Done : BOOLEAN; (* Quit *)
- print : BOOLEAN; (* print text? *)
- save : BOOLEAN; (* save block? *)
- copy : BOOLEAN; (* copy block to clipboard? *)
- NewText : BOOLEAN; (* load new text *)
- Info : BOOLEAN; (* is info currently displayed ? *)
- modeReq : BOOLEAN; (* Show Display Mode Requester? *)
- Scroll : BOOLEAN; (* scrolling or waiting? *)
- Fast : BOOLEAN; (* scroll quick? *)
- Sync : BOOLEAN; (* scroll very quick? *)
- Decrunched : BOOLEAN; (* Is file decrunched? *)
- Scrollable : BOOLEAN; (* is screen able to scroll? *)
- refresh : BOOLEAN; (* Refresh Window? *)
- oldstyle : BOOLEAN; (* Page Up/Down with soft scroll? *)
- lace : BOOLEAN; (* Is screen interlaced? *)
- cLocked : BOOLEAN; (* Is C: locked ? *)
- NewDisp : BOOLEAN; (* need to rebuild Display ? *)
- fastquit : BOOLEAN;
- style : SHORTSET; (* Text style *)
- mySig : LONGSET; (* My Signal Set *)
- showSig : LONGSET; (* ShowTask's Signal Set *)
- Me : d.ProcessPtr; (* my main task *)
- meInt : LONGINT; (* for making unique filename *)
- MyMsgPtr : I.IntuiMessagePtr; (* for receiving Messages *)
- in,out : d.FileHandlePtr; (* i/o for TYPE xxx TO PRT: *)
- mySigBit : INTEGER; (* My Signal Bit *)
- showSigBit : INTEGER; (* ShowTask's Sig Bit *)
- frame : INTEGER; (* Frame Count *)
- fg,bg : INTEGER; (* Text colors *)
- oldfg,oldbg : INTEGER; (* Old Text colors *)
- tabw : INTEGER; (* Tabulator width *)
- rd : d.RDArgsPtr; (* For ReadArgs *)
- args : Args; (* My CLI Args *)
- ArgPtr : StringPtr; (* to get WBArg *)
- wbm : WBStartupPtr; (* WBenchMessage *)
- ri : g.RasInfoPtr; (* Screen's ViewPort's RasInfo *)
- dims : g.DimensionInfo; (* Dims for KS2.0 *)
- disp : g.DisplayInfo; (* DisplayInfo for KS2.0 *)
- StrGadget : I.Gadget; (* Gadget for Find-Command *)
- StrInfo : I.StringInfo; (* its special info *)
- asl : e.LibraryPtr; (* ASL-librarybase *)
- diskFontBase : e.LibraryPtr; (* DiskFont-LibraryBase *)
- xpk : e.LibraryPtr; (* XpkMaster-Librarybase *)
- iconBase : e.LibraryPtr; (* Icon-Librarybase *)
- Filename : String; (* The Filename (without path) *)
- Dirname : String; (* its path *)
- Pattern : ARRAY 80 OF CHAR; (* The pattern for Filerequester *)
- TextMarkers : ARRAY 10 OF TextLinePtr; (* Marked Positions in text *)
- FindLine : TextLinePtr; (* Last found line *)
- KeyMap : ARRAY 50H OF CHAR; (* console's KeyMap *)
- Password : String; (* Password for encrypted texts *)
- conreq : e.IOStdReqPtr; (* Console IO-Request *)
- console : e.DevicePtr; (* the console.device *)
- ievent : ie.InputEventPtr; (* InputEvent to convert keycodes *)
- WriteName : String; (* File to write Block *)
- savefrom,savesize: LONGINT; (* How much to save? *)
- iff : ip.IFFHandlePtr; (* IFF Handle for clipboard copy *)
- buffer : UNTRACED POINTER TO CHAR; (* Save buffer *)
- MemIndex : INTEGER; (* index in current Chunk *)
- CurChunk : MemChunkPtr; (* current chunk *)
- c : CHAR; (* \ used by GetTextLine(); *)
- le : INTEGER; (* / global for speed *)
-
-
- (*-------------------------------------------------------------------------*)
-
- PROCEDURE OpenDiskFont*{diskFontBase,-30}(VAR textAttr{8}: g.TextAttr): g.TextFontPtr;
-
- PROCEDURE GetDiskObject {iconBase,- 78}(name{8} : ARRAY OF CHAR): DiskObjectPtr;
- PROCEDURE FreeDiskObject{iconBase,- 90}(diskobj{8} : DiskObjectPtr);
- PROCEDURE FindToolType {iconBase,- 96}(toolTypes{8} : e.APTR;
- typeName{9} : ARRAY OF CHAR): StringPtr;
- PROCEDURE MatchToolValue{iconBase,-102}(typeString{8} : ARRAY OF CHAR;
- val{9} : ARRAY OF CHAR): BOOLEAN;
-
- (*-------------------------------------------------------------------------*)
-
- (* $Debug- *)
-
- PROCEDURE StuffChar; (* $EntryExitCode- *)
- BEGIN
- SYS.INLINE(016C0U, 04E75U)
- END StuffChar;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE LocStr (num: LONGINT): e.STRPTR;
- VAR default: e.STRPTR;
-
- BEGIN
- default := MSGS[num];
- IF loc.base=NIL THEN RETURN default
- ELSE RETURN loc.GetCatalogStr(catalog,num,default^) END;
- END LocStr;
-
-
- (*----------------------------- Requester: ------------------------------*)
-
-
- PROCEDURE Request(Text: ARRAY OF CHAR); (* $CopyArrays- *)
- VAR es: I.EasyStruct;
-
- BEGIN
- IF ol.wbStarted THEN
- es.structSize := SIZE(I.EasyStruct);
- es.flags := LONGSET{};
- es.title := SYS.ADR(MuchText);
- es.textFormat := SYS.ADR(Text);
- es.gadgetFormat := LocStr(MSGOK);
- IF I.EasyRequest(NIL,SYS.ADR(es),NIL,NIL)=0 THEN END;
- ELSE
- SYS.SETREG(0,d.Write(d.Output(),Text,str.Length(Text)));
- SYS.SETREG(0,d.Write(d.Output(),"\n",1));
- END;
- HALT(d.fail);
- END Request;
-
-
- PROCEDURE OutOfMemHandler;
- VAR es: I.EasyStruct;
-
- BEGIN
- es.structSize := SIZE(I.EasyStruct);
- es.flags := LONGSET{};
- es.title := SYS.ADR(MuchText);
- es.textFormat := LocStr(MSGOOM);
- es.gadgetFormat := LocStr(MSGRETRYABORT);
- IF I.EasyRequest(NIL,SYS.ADR(es),NIL,NIL)=0 THEN
- HALT(d.fail)
- END;
- END OutOfMemHandler;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE AllocLine(sz: INTEGER): TextLinePtr;
-
- VAR newchunk: MemChunkPtr;
-
- BEGIN
- INC(sz,SIZE(TextLine)-MaxLen); IF ODD(sz) THEN INC(sz) END;
- IF MemIndex+sz<=ChunkSize THEN (* does mem fit into current chunk ? *)
- INC(MemIndex,sz); (* increment index in current chunk *)
- ELSE
- NEW(newchunk); (* allocate new chunk *)
- newchunk.prev := CurChunk; (* link chunk into list *)
- CurChunk := newchunk;
- MemIndex := sz;
- END;
- RETURN SYS.ADR(CurChunk.data[MemIndex-sz]);
- END AllocLine;
-
-
- PROCEDURE DisposeLines();
-
- VAR chunk: MemChunkPtr;
-
- BEGIN
- WHILE CurChunk#NIL DO
- chunk := CurChunk.prev;
- DISPOSE(CurChunk);
- CurChunk := chunk;
- END;
- MemIndex := ChunkSize;
- END DisposeLines;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE Busy;
- BEGIN
- IF Window#NIL THEN
- I.OldModifyIDCMP(Window,MyIdcmp-LONGSET{I.rawKey,I.mouseButtons});
- IF I.base.libNode.version >= 39 THEN
- I.SetWindowPointer(Window,I.waBusyPointer,I.LTRUE,u.done);
- ELSE
- I.SetPointer(Window,busyPointer^,16,16,-6,0);
- END;
- END;
- END Busy;
-
-
- PROCEDURE UnBusy;
- BEGIN
- IF Window#NIL THEN
- IF I.base.libNode.version >= 39 THEN
- I.SetWindowPointer(Window,u.done);
- ELSE
- I.ClearPointer(Window);
- END;
- I.OldModifyIDCMP(Window,MyIdcmp);
- END;
- END UnBusy;
-
-
- (*------ Scroll: ------*)
-
- PROCEDURE MakeScroll(sync,fast,always: BOOLEAN);
- VAR m: INTEGER;
-
- BEGIN
- IF Scrollable THEN
- m := 1;
- IF ~always THEN
- IF lace & ~fast THEN m := 2 END;
- IF ~sync THEN INC(m,m*2) END;
- END;
- IF (m=1) OR (frame MOD m=0) THEN
-
- CASE scrollmode OF
-
- | 1: g.ScrollVPort(SYS.ADR(Screen.viewPort));
- g.WaitTOF;
-
- | 2: I.OldMakeScreen(Screen);
- I.OldRethinkDisplay();
-
- (* 3: ScrollRaster *)
-
- | 4: g.WaitTOF;
- g.ScrollVPort(SYS.ADR(Screen.viewPort));
-
- | 5: g.ScrollVPort(SYS.ADR(Screen.viewPort));
- g.WaitBOVP(SYS.ADR(Screen.viewPort));
-
- ELSE (* 0: *)
- I.OldMakeScreen(Screen);
- e.Forbid; g.MrgCop(I.ViewAddress()); e.Permit;
- g.WaitTOF;
-
- END;
- END;
- (* $OvflChk- *)
- INC(frame);
- (* $OvflChk= *)
- END;
- END MakeScroll;
-
-
- (*------ Clear Display: ------*)
-
- PROCEDURE ClearDisplay;
- BEGIN
- IF win THEN
- g.SetAPen(rp,0);
- g.RectFill(rp,left,top,left+width-1,top+height-1);
- ELSE
- g.SetRast(rp,0);
- END;
- IF Scrollable THEN
- ri.ryOffset := 0;
- ScreenPos := 0;
- MakeScroll(f,f,w);
- END;
- END ClearDisplay;
-
- (*-------------------------------------------------------------------------*)
-
- (*------ Read one TextLine into a Variable: ------*)
-
-
- PROCEDURE GetTextLine(): TextLinePtr;
- (* returns NIL at EOF *)
-
- VAR
- l : TextLinePtr;
- sz,wd,i,j: INTEGER;
- txt : ARRAY MaxLen+1 OF CHAR;
- num : ARRAY 10 OF INTEGER;
- newcol : BOOLEAN;
- oldstyle : SHORTSET;
-
- PROCEDURE GetCh();
- BEGIN
- IF RQPos=RQLen THEN
- RQLen := d.Read(MyFile,Buffer^,BufferSize);
- IF RQLen<0 THEN Request(LocStr(MSGRWERR)^) END;
- RQPos := 0;
- END;
- IF RQLen=0 THEN c := 0X ELSE
- c := Buffer[RQPos]; IF c=0X THEN c:=1X END;
- INC(RQPos); INC(le);
- END;
- END GetCh;
-
- BEGIN
- IF RQLen=0 THEN RETURN NIL END;
- sz := 0; wd := 0; le := 0;
- IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END; INC(sz)
- ELSE IF Bold IN style THEN txt[sz] := bold; INC(sz) END END;
- IF Ulin IN style THEN txt[sz] := ulineon; INC(sz) END;
- IF Inv IN style THEN txt[sz] := CHR(fg+4*bg+1); INC(sz)
- ELSIF (fg#1) OR (bg#0) THEN txt[sz] := CHR(bg+4*fg+1); INC(sz) END;
- LOOP
- LOOP
- GetCh;
- IF SYS.VAL(CHAR,SYS.VAL(SHORTSET,c)*SHORTSET{0..6})#1BX THEN EXIT END;
- i := -1;
- REPEAT
- GetCh;
- IF (c>=30X) & (c<=39X) THEN
- INC(i); num[i] := 0;
- REPEAT
- num[i] := 10*num[i]+ORD(c)-ORD(30X); GetCh;
- UNTIL (c<30X) OR (c>39X);
- END;
- c := CAP(c);
- UNTIL (c>=3FX(*"?"*)) & (c<=5AX) OR (c=0X) OR (i=9);
- IF c=4DX THEN
- newcol := f; oldstyle := style; j := 0;
- IF i=-1 THEN i:=0; num[0] := 0 END;
- WHILE (i>=j) & (sz<MaxLen-1) DO
- CASE num[j] OF
- 0: style := SHORTSET{}; fg := 1; bg := 0; newcol := w |
- 1: INCL(style,Bold) |
- 2: fg := 2; newcol := w |
- 3: INCL(style,Italic) |
- 4: INCL(style,Ulin) |
- 7: INCL(style,Inv); newcol := w |
- 8: oldfg:=fg; oldbg:=bg; fg:=0; bg:=0; newcol := w |
-
- 22: EXCL(style,Bold); fg := 1; newcol := w |
- 23: EXCL(style,Italic) |
- 24: EXCL(style,Ulin) |
- 27: EXCL(style,Inv); newcol := w |
- 28: fg:=oldfg; bg:=oldbg; newcol := w |
-
- 30..37: fg := (num[j]-30) MOD 4; newcol := w |
- 39: fg := 1; newcol := w |
-
- 40..47: bg := (num[j]-40) MOD 4; newcol := w |
- 49: bg := 0; newcol := w |
-
- ELSE END;
- INC(j);
- END;
- IF (oldstyle#style) & (sz<MaxLen) THEN
- IF Italic IN style THEN IF Bold IN style THEN txt[sz] := boldit ELSE txt[sz] := italic END;
- ELSE IF Bold IN style THEN txt[sz] := bold ELSE txt[sz] := plain END;
- END;
- INC(sz);
- IF (Ulin IN style) THEN
- IF ~((Ulin IN oldstyle)) & (sz<MaxLen) THEN
- txt[sz] := ulineon;
- INC(sz);
- END;
- ELSE
- IF (Ulin IN oldstyle) & (sz<MaxLen) THEN
- txt[sz] := ulineoff;
- INC(sz);
- END;
- END;
- END;
- IF newcol & (sz<MaxLen) THEN
- IF Inv IN style THEN txt[sz] := CHR(fg+4*bg+1)
- ELSE txt[sz] := CHR(bg+4*fg+1) END;
- INC(sz);
- END;
- END; (* IF c="m" THEN *)
- END; (* LOOP *)
- CASE c OF
- 020X.. 7FX: txt[sz] := c; INC(sz); INC(wd) |
- 0A1X..0FFX: txt[sz] := c; INC(sz); INC(wd) |
- 8X: (* BS *) IF wd>0 THEN DEC(sz); DEC(wd); END |
- 9X: (* TAB *) REPEAT
- txt[sz] := 20X; INC(sz); INC(wd)
- UNTIL (sz=MaxLen) OR (wd=NumColumns) OR (sz MOD tabw=0) |
- 0A0X: txt[sz] := 20X; INC(sz); INC(wd) |
- 0AX,0X,0CX: EXIT
- ELSE
- END;
- IF (wd>=NumColumns) OR (sz>=MaxLen) THEN EXIT END;
- END;
- txt[sz] := 0X; INC(sz);
- l := AllocLine(sz);
- l.len := le; l.size:= sz;
- WHILE sz>0 DO DEC(sz); l.text[sz] := txt[sz] END;
- INC(ReadLength,le);
- RETURN l;
- END GetTextLine;
-
-
- (*------ Write Line to Screen: ------*)
-
-
- PROCEDURE Type(pos: INTEGER; line: TextLinePtr);
-
- VAR
- style: SHORTSET;
- front,back: SHORTINT;
- c: CHAR;
- last,i,x,y: INTEGER;
- strPtr: StringPtr;
-
- BEGIN
- g.SetDrMd(rp,g.jam2);
- IF Scrollable THEN
- g.SetAPen(rp,0);
- y := pos * fontHeight;
- IF ~refresh THEN g.RectFill(rp,0,y,width-1,y+fontHeight-spacing-1) END;
- END;
- i := 0; x := 0; style := SHORTSET{}; front := 1; back := 0;
- LOOP
- WHILE line.text[i] < " " DO
- c := line.text[i];
- IF c=0X THEN EXIT END;
- CASE c OF
- plain : style := style - SHORTSET{g.bold,g.italic} |
- italic : EXCL(style,g.bold); INCL(style,g.italic) |
- bold : INCL(style,g.bold); EXCL(style,g.italic) |
- boldit : style := style + SHORTSET{g.bold,g.italic} |
- ulineon : INCL(style,g.underlined) |
- ulineoff: EXCL(style,g.underlined) |
- 1X..10X : DEC(c);
- front := SHORT(ORD(c)) DIV 4;
- back := SHORT(ORD(c)) MOD 4 |
- ELSE END;
- INC(i);
- END;
- strPtr := SYS.ADR(line.text[i]); last := i;
- REPEAT INC(i) UNTIL line.text[i]<" ";
- SYS.SETREG(0,g.SetSoftStyle(rp,style,-SHORTSET{}));
- g.SetAPen(rp,front);
- g.SetBPen(rp,back);
- g.Move(rp,left+fontWidth*x,top+fontHeight*pos+fontBaseLine);
- g.Text(rp,strPtr^,i-last);
- INC(x,i-last);
- END;
- END Type;
-
-
- PROCEDURE CopyScrollLine(pos: INTEGER);
- (* Kopiert die an pos geschriebene Zeile auf den entsprechenden
- * DoubleBuffer-Bereich
- * ACHTUNG: Darf nur aufgerufen werden, wenn Scrollable TRUE ist!
- *)
-
- VAR
- y,z: INTEGER;
-
- BEGIN
- y := pos*fontHeight;
- z := PageHeight;
- IF pos >= NumLines THEN z := -z END;
- SYS.SETREG(0,g.BltBitMap(BM, 0,y, BM, 0,y+z, width,fontHeight, 0C0X, SHORTSET{0..7}, NIL));
- END CopyScrollLine;
-
-
- (*------ Copy String to TextLine: ------*)
-
-
- PROCEDURE CopyToWriteText(String: StringPtr);
- VAR i,j : INTEGER;
-
- BEGIN
- e.CopyMem(String^,writeText.text,MaxLen-1);
- j := 0;
- FOR i := 0 TO SHORT(str.Length(writeText.text))-1 DO
- IF writeText.text[i] >= " " THEN INC(j) END;
- IF j >= NumColumns THEN
- writeText.text[i] := 0X;
- RETURN
- END;
- END;
- END CopyToWriteText;
-
-
- (*------ Write String to Screen (at any position): ------*)
-
-
- PROCEDURE TypeTo(VAR text: TextLine; pos: INTEGER);
-
- BEGIN
- IF pos < NumLines THEN
- IF Scrollable THEN
- INC(pos,ScreenPos);
- Type(pos,SYS.ADR(text));
- CopyScrollLine(pos);
- ELSE
- Type(pos,SYS.ADR(text));
- END;
- END;
- END TypeTo;
-
-
- (*------ Write String to Screen (at any position): ------*)
-
-
- PROCEDURE WriteTo(String: StringPtr; pos: INTEGER);
-
- BEGIN
- CopyToWriteText(String);
- TypeTo(writeText,pos);
- END WriteTo;
-
-
- (*------ Write Line at Bottom of Text: ------*)
-
-
- PROCEDURE AddBottomLine(Line: TextLinePtr; Fast: BOOLEAN);
- VAR i,y: INTEGER;
-
- BEGIN
- IF ~Scrollable THEN
- g.SetAPen(rp,0); g.SetBPen(rp,0);
- IF Fast THEN
- g.ScrollRaster(rp,0,fontHeight,left,top,left+width-1,top+height-1);
- IF Sync THEN g.WaitTOF END;
- ELSE
- i := fontHeight;
- REPEAT
- IF Window.height=initialheight THEN (* Prevent crash under v37 *)
- g.ScrollRaster(rp,0,1,left,top,left+width-1,top+height-1);
- END;
- IF Sync THEN g.WaitTOF END;
- DEC(i);
- UNTIL i=0;
- END;
- Type(NumLines-1,Line);
- ELSE
- Type(ScreenPos+NumLines,Line);
- y := ScreenPos*fontHeight;
- IF Fast THEN
- INC(ri.ryOffset,fontHeight);
- MakeScroll(Sync,w,f);
- SYS.SETREG(0,g.BltBitMap(BM, 0,y+PageHeight, BM, 0,y, width,fontHeight, 0C0X, SHORTSET{0..7}, NIL));
- ELSE
- i := fontHeight;
- REPEAT
- INC(ri.ryOffset);
- MakeScroll(Sync,f,f);
- SYS.SETREG(0,g.BltBitMap(BM, 0,y+PageHeight, BM, 0,y, width,1, 0C0X, SHORTSET{0..7}, NIL));
- INC(y);
- DEC(i);
- UNTIL i=0;
- END;
- INC(ScreenPos);
- IF ScreenPos=NumLines THEN
- ScreenPos := 0;
- ri.ryOffset := 0;
- END;
- END;
- END AddBottomLine;
-
-
- (*------ Check whether BottomLine.next is NIL or not: ------*)
-
-
- PROCEDURE TryBottomnext(): BOOLEAN;
- (* returns TRUE if BottomLine.next#NIL END; *)
-
- BEGIN
- IF (BottomLine.next=NIL) & (MyFile#NIL) THEN
- SignalNewData := w;
- SYS.SETREG(0,e.Wait(mySig));
- SignalNewData := f;
- END;
- RETURN BottomLine.next#NIL;
- END TryBottomnext;
-
-
- (*------ Scroll down one Line: ------*)
-
-
- PROCEDURE ScrollDown(Fast: BOOLEAN);
-
- BEGIN
- IF TryBottomnext() THEN
- BottomLine := BottomLine.next;
- INC(AnzLines);
- INC(TextLength,BottomLine.len);
- ELSE RETURN END;
- IF AnzLines >= NumLines THEN TopLine := TopLine.next END;
- AddBottomLine(BottomLine,Fast);
- END ScrollDown;
-
-
- (*------ Scroll Up one Line: ------*)
-
-
- PROCEDURE ScrUp (Fast: BOOLEAN);
- VAR
- i,y: INTEGER;
-
- BEGIN
- IF ~Scrollable THEN
- g.SetAPen(rp,0); g.SetBPen(rp,0);
- IF Fast THEN
- g.ScrollRaster(rp,0,-fontHeight,left,top,left+width-1,top+height-1);
- IF Sync THEN g.WaitTOF END;
- ELSE
- i := fontHeight;
- REPEAT
- IF Window.height=initialheight THEN
- g.ScrollRaster(rp,0,-1,left,top,left+width-1,top+height-1);
- END;
- IF Sync THEN g.WaitTOF END;
- DEC(i)
- UNTIL i=0;
- END;
- IF TopLine.prev#NIL THEN Type(0,TopLine.prev) ELSE Type(0,FirstLine) END;
- ELSE
- IF ScreenPos=0 THEN
- ri.ryOffset := NumLines*fontHeight;
- ScreenPos := NumLines;
- END;
- DEC(ScreenPos);
- IF TopLine.prev#NIL THEN Type(ScreenPos,TopLine.prev) ELSE Type(ScreenPos,FirstLine) END;
- y := ScreenPos*fontHeight;
- IF Fast THEN
- DEC(ri.ryOffset,fontHeight);
- MakeScroll(Sync,w,f);
- SYS.SETREG(0,g.BltBitMap(BM, 0,y, BM, 0,y+PageHeight, width,fontHeight , 0C0X, SHORTSET{0..7}, NIL));
- ELSE
- INC(y,fontHeight);
- i := fontHeight;
- REPEAT
- DEC(ri.ryOffset);
- MakeScroll(Sync,f,f);
- DEC(y);
- SYS.SETREG(0,g.BltBitMap(BM, 0,y, BM, 0,y+PageHeight, width,1, 0C0X, SHORTSET{0..7}, NIL));
- DEC(i);
- UNTIL i=0;
- END;
- END;
- END ScrUp;
-
-
- PROCEDURE ScrollUp(Fast: BOOLEAN);
-
- BEGIN
- IF (TopLine.prev#NIL) & (TopLine.prev.prev#NIL) THEN
- TopLine := TopLine.prev;
- DEC(TextLength,BottomLine.len);
- DEC(AnzLines);
- BottomLine := BottomLine.prev;
- ScrUp(Fast);
- END;
- END ScrollUp;
-
-
- (*------ Undo last AddBottomLine: ------*)
-
-
- PROCEDURE DelLine(Fast: BOOLEAN);
-
- BEGIN
- ScrUp(Fast);
- Info := f;
- END DelLine;
-
-
- (*------ Convert String to Integer: ------*)
-
- PROCEDURE StrToInt(str: StringPtr; base: INTEGER): LONGINT;
-
- VAR
- i,j: INTEGER;
- num: LONGINT;
- ch : CHAR;
- neg: BOOLEAN;
-
- BEGIN
- num := 0; i := 0; neg := f;
- IF str^[0] = '-' THEN str:=SYS.ADR(str[1]); neg := w END;
- IF str^[0] = '$' THEN str:=SYS.ADR(str[1]); base:=16 END;
- IF (str^[0]='0')&(CAP(str^[1])='X') THEN str:=SYS.ADR(str[2]); base:=16 END;
- LOOP
- IF i=LEN(str^) THEN EXIT END;
- ch := CAP(str^[i]);
- IF ch=0X THEN EXIT END;
- j := ORD(ch);
- CASE ch OF
- "0".."9": DEC(j,ORD('0')) |
- "A".."F": DEC(j,ORD('A')-10);
- IF base=10 THEN base:=16; i:=-1; j:=0; num:=0 END;
- ELSE EXIT
- END;
- num := num * base + j;
- INC(i);
- END;
- IF neg THEN num := -num END;
- RETURN num
- END StrToInt;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE GetLength(t: TextLinePtr);
-
- BEGIN
- TextLength := 0; AnzLines := 0;
- WHILE t#NIL DO INC(AnzLines); INC(TextLength,t.len); t := t.prev END;
- END GetLength;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE NewDisplay;
- (* Zeichnet ab BottomLine neu *)
-
- VAR
- i: INTEGER;
- l: TextLinePtr;
-
- BEGIN
- IF ~refresh THEN ClearDisplay END;
- l := BottomLine.prev;
- IF l#NIL THEN BottomLine := l END;
- l := BottomLine;
- i := NumLines-1;
- WHILE (i>0) & TryBottomnext() DO
- BottomLine := BottomLine.next;
- DEC(i);
- END;
- WHILE (i>0) & (l.prev#NIL) DO
- l := l.prev;
- DEC(i);
- END;
- TopLine := l.next;
- WHILE i<NumLines DO
- BottomLine := l;
- TypeTo(BottomLine^,i);
- INC(i);
- l := l.next;
- END;
- GetLength(BottomLine);
- Scroll := f;
- Info := f;
- END NewDisplay;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE GetString(VAR str: ARRAY OF CHAR; int,newdisp: BOOLEAN);
- VAR
- Win: I.WindowPtr;
- msg: I.IntuiMessagePtr;
- class: LONGSET;
- l,t,w,h: INTEGER;
- screen: I.ScreenPtr;
-
- BEGIN
- MakeScroll(f,f,TRUE);
- Busy;
- screen := Screen;
- w := width DIV 4 * 3;
- l := (width-w) DIV 2;
- t := height DIV 2;
- IF Screen # NIL THEN
- IF Scrollable THEN INC(t,ri.ryOffset) END;
- h := Screen.font.ySize+4;
- ELSE
- screen := Window.wScreen;
- INC(l,Window.leftEdge);
- INC(t,Window.topEdge);
- h := screen.font.ySize+4;
- END;
- StrGadget.leftEdge := 4;
- StrGadget.topEdge := 2;
- StrGadget.width := w-8;
- StrGadget.height := h-4;
- StrGadget.activation := {I.stringCenter,I.relVerify};
- IF int THEN INCL(StrGadget.activation,I.longint) END;
- StrGadget.gadgetType := I.strGadget;
- StrGadget.specialInfo:= SYS.ADR(StrInfo);
- StrInfo.buffer := SYS.ADR(str);
- StrInfo.maxChars := SHORT(LEN(str))-1;
-
- IF Scrollable THEN Screen.height := Screen.height * 2 END;
-
- Win := I.OpenWindowTagsA(NIL,
- I.waLeft, l,
- I.waTop, t,
- I.waWidth, w,
- I.waHeight,h,
- I.waIDCMP, LONGSET{I.gadgetUp,I.activeWindow,I.inactiveWindow},
- I.waFlags, LONGSET{I.rmbTrap,I.activate,I.noCareRefresh},
- I.waGadgets,SYS.ADR(StrGadget),
- I.waCustomScreen,screen,
- u.done);
-
- IF Scrollable THEN Screen.height := Screen.height DIV 2 END;
-
- IF Win # NIL THEN
- e.WaitPort(Win.userPort);
- SYS.SETREG(0,I.ActivateGadget(StrGadget,Win,NIL));
- LOOP
- e.WaitPort(Win.userPort);
- msg := e.GetMsg(Win.userPort);
- IF msg # NIL THEN
- class := msg.class;
- e.ReplyMsg(msg);
- IF (I.gadgetUp IN class) OR (I.inactiveWindow IN class) THEN
- EXIT
- END;
- END;
- END;
- I.CloseWindow(Win); Win := NIL;
- END;
- UnBusy;
- IF newdisp & ~win THEN
- refresh := TRUE; BottomLine := TopLine; NewDisplay; refresh := f;
- END;
- END GetString;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE OpenDisplay;
- BEGIN
-
- (*------ Open Screen: ------*)
-
- IF ~win THEN
-
- LOOP
-
- IF id=g.invalidID THEN
- id := g.defaultMonitorID;
- pub := I.LockPubScreen(NIL);
- IF pub # NIL THEN
- id := g.GetVPModeID(SYS.ADR(pub.viewPort));
- I.UnlockPubScreen(NIL,pub);
- END;
- END;
-
- IF g.GetDisplayInfoData(NIL,dims,SIZE(dims),g.dtagDims,id) > 0 THEN
- width := dims.txtOScan.maxX - dims.txtOScan.minX + 1;
- height := dims.txtOScan.maxY - dims.txtOScan.minY + 1;
-
- IF g.GetDisplayInfoData(NIL,disp,SIZE(disp),g.dtagDisp,id) > 0 THEN
- lace := g.isLace IN disp.propertyFlags;
- Scrollable := (g.isDraggable IN disp.propertyFlags) & (scrollmode # 3);
- IF Scrollable THEN INC(height,height) END;
-
- Screen := I.OpenScreenTagsA(NIL,
- I.saLeft, 0,
- I.saTop, 0,
- I.saWidth, width,
- I.saHeight, height,
- I.saDepth, depth,
- I.saDisplayID, id,
- I.saInterleaved,SYS.VAL(SHORTINT,interleaved),
- I.saOverscan, I.oScanText,
- I.saPens, SYS.ADR("\xFF\xFF"),
- I.saQuiet, I.LTRUE,
- u.end);
- END;
- END;
-
- IF Screen # NIL THEN EXIT END;
-
- DEC(depth);
- IF depth=0 THEN Request(LocStr(MSGCOS)^) END;
- END;
-
- rp := SYS.ADR(Screen.rastPort);
- BM := rp.bitMap;
- ri := Screen.viewPort.rasInfo;
-
- IF ci>0 THEN g.LoadRGB4(SYS.ADR(Screen.viewPort),Cols,ci) END;
-
- left := 0;
- top := 0;
- width := Screen.width;
- height := Screen.height;
-
- END;
-
- (*------ Open Window: ------*)
-
- IF win THEN
-
- IF pubscreenname="" THEN pub := I.LockPubScreen(NIL);
- ELSE pub := I.LockPubScreen(pubscreenname) END;
- IF pub # NIL THEN
-
- zoomBox[0] := left;
- zoomBox[1] := top;
- zoomBox[2] := 200;
- zoomBox[3] := pub.barHeight+1;
-
- Window := I.OpenWindowTagsA(NIL,
- I.waTitle, SYS.ADR(MuchText),
- I.waLeft, left,
- I.waTop, top,
- I.waWidth, width,
- I.waHeight, height,
- I.waPubScreen,pub,
- I.waIDCMP, MyIdcmp,
- I.waFlags, LONGSET{I.windowDrag,I.windowClose,I.windowDepth,I.rmbTrap,I.activate,I.noCareRefresh},
- I.waZoom, SYS.ADR(zoomBox),
- u.done);
- I.UnlockPubScreen(NIL,pub);
- END;
-
- ELSE
-
- Window := I.OpenWindowTagsA(NIL,
- I.waLeft, 0,
- I.waTop, 10,
- I.waWidth, width,
- I.waHeight, height-10,
- I.waCustomScreen,Screen,
- I.waIDCMP, MyIdcmp,
- I.waFlags, LONGSET{I.rmbTrap,I.activate,I.borderless,I.noCareRefresh,I.simpleRefresh,I.backDrop},
- u.done);
- END;
-
- IF Window=NIL THEN Request(LocStr(MSGCOW)^) END;
- initialheight := Window.height;
-
- IF win THEN
- rp := Window.rPort;
- left := Window.borderLeft; top := Window.borderTop;
- width := Window.gzzWidth; height := Window.gzzHeight;
- Scrollable := f;
- IF g.base.libNode.version >= 39 THEN g.SetMaxPen(rp,ASH(LONG(1),depth)-1)
- ELSE rp.mask := SHORTSET{0..depth-1} END;
- END;
-
- (*------ Open Font: ------*)
-
- IF FontName[0] # 0X THEN
- MyAttr.name := SYS.ADR(FontName);
- MyAttr.ySize := FontSize;
- IF diskFontBase # NIL THEN MyFont := OpenDiskFont(MyAttr) END;
- IF (MyFont # NIL) & ~(g.proportional IN MyFont.flags) THEN g.SetFont(rp,MyFont) END;
- END;
-
- LOOP
- fontWidth := rp.font.xSize;
- fontHeight := rp.font.ySize;
- IF (fontWidth<=50) & (fontHeight<=50) & (fontWidth>=4) & (fontHeight>=4) THEN EXIT END;
- MyAttr.name := SYS.ADR("topaz.font");
- MyAttr.ySize := 8;
- MyFont := g.OpenFont(MyAttr);
- IF MyFont=NIL THEN HALT(d.fail) END;
- g.SetFont(rp,MyFont);
- END;
- INC(fontHeight,spacing); (* extra spacing *)
- fontBaseLine := rp.font.baseline;
-
- NumColumns := width DIV fontWidth;
- IF Scrollable THEN NumLines := (height DIV 2) DIV fontHeight;
- ELSE NumLines := height DIV fontHeight; END;
- PageHeight := fontHeight*NumLines;
- height := PageHeight;
-
- ClearDisplay;
-
- IF Scrollable THEN
- Screen.height := height;
- I.OldMakeScreen(Screen);
- I.OldRethinkDisplay;
- ELSIF win THEN
- INC(top,(Window.gzzHeight-height) DIV 2);
- END;
-
- END OpenDisplay;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE * ShowProc;
-
- VAR
- l : TextLinePtr;
- Down : BOOLEAN; (* Scroll-Direction *)
- Shift : BOOLEAN; (* Shifted Keystroke ? *)
- Alt : BOOLEAN; (* Altered Keystroke ? *)
- wasInfo : BOOLEAN; (* was Info line displayed ? *)
- found : BOOLEAN; (* TRUE, if find was successful *)
- chr : CHAR; (* converted keycode *)
- caseDelta : SHORTINT; (* Case sensitive Search? *)
- flen : INTEGER; (* length of findstring *)
- i,j : INTEGER; (* Count *)
- Class : LONGSET; (* contains Message.class *)
- Code : INTEGER; (* contains Message.code *)
- Qualifier : SET; (* contains Message.qualifier *)
- Find,FindStr: ARRAY 80 OF CHAR; (* findstring / capital findstring *)
- Goto : ARRAY 10 OF CHAR; (* string containing goto line # *)
- li : LONGINT; (* longint value of line to go to *)
- HiText : TextLine; (* Highlited textline *)
- OldHiText : TextLinePtr; (* original, un-hilited text *)
- skipTab : ARRAY 256 OF INTEGER;(* for Boyer-Moore Alg. *)
-
-
- PROCEDURE WaitAllRead();
-
- BEGIN
- IF MyFile # NIL THEN
- Busy;
- SignalAllRead := w;
- SYS.SETREG(0,e.Wait(showSig));
- SignalAllRead := f;
- UnBusy;
- END;
- END WaitAllRead;
-
-
- PROCEDURE HiLite(at,len: INTEGER);
- (* Hilites len chars of BottomLine.text starting at position at *)
-
- VAR
- c: INTEGER;
- col: CHAR;
-
- BEGIN
- OldHiText := BottomLine; HiText := OldHiText^; BottomLine := SYS.ADR(HiText);
- IF at+len+2<MaxLen THEN
- c := 0; col := 5X;
- WHILE c<at DO
- IF HiText.text[c]<CHR(17) THEN col := HiText.text[c] END;
- INC(c);
- END;
- HiText.text[at] := CHR(17-ORD(col));
- c := at; INC(len,at);
- WHILE c<len DO
- HiText.text[c+1] := OldHiText.text[c];
- INC(c);
- END;
- HiText.text[c+1] := col;
- REPEAT
- HiText.text[c+2] := OldHiText.text[c];
- INC(c);
- UNTIL HiText.text[c-1]=0X;
- END;
- IF HiText.next#NIL THEN HiText.next.prev := SYS.ADR(HiText) END;
- IF HiText.prev#NIL THEN HiText.prev.next := SYS.ADR(HiText) END;
- END HiLite;
-
-
- PROCEDURE UnHiLite();
-
- BEGIN
- IF HiText.next#NIL THEN HiText.next.prev := OldHiText END;
- IF HiText.prev#NIL THEN HiText.prev.next := OldHiText END;
- END UnHiLite;
-
-
- PROCEDURE CalcSkipTab; (* Make skip-table for Boyer-Moore Alg. *)
- VAR i,j: INTEGER;
-
- BEGIN
- FOR i := 0 TO 255 DO skipTab[i] := flen END;
- i := 0;
- FOR j := flen-1 TO 0 BY -1 DO
- IF skipTab[ORD(FindStr[j])] = flen THEN
- skipTab[ORD(FindStr[j])] := i;
- END;
- INC(i);
- END;
- END CalcSkipTab;
-
-
- PROCEDURE Search(): BOOLEAN;
- (* Searches string and hilites it if found. Result is TRUE if string found *)
-
- VAR ch: CHAR;
- i,j,t: INTEGER;
-
- BEGIN
- IF flen > BottomLine.size THEN RETURN f END;
- i := flen-1;
- FOR j := flen-1 TO 0 BY -1 DO
- LOOP
- ch := BottomLine.text[i];
- CASE ch OF "a".."z","à".."ö","ø".."þ": DEC(ch,caseDelta) ELSE END;
- IF ch = FindStr[j] THEN EXIT END;
- t := skipTab[ORD(ch)];
- IF flen-j > t THEN INC(i,flen-j) ELSE INC(i,t) END;
- IF i >= BottomLine.size THEN RETURN f END;
- j := flen-1;
- END;
- DEC(i);
- END;
- INC(i); IF i<0 THEN RETURN f END;
- SYS.SETREG(0,TryBottomnext());
- FindLine := BottomLine;
- HiLite(i,flen);
- found := w; RETURN w;
- END Search;
-
-
- PROCEDURE ShowInfo(Fast: BOOLEAN);
- VAR IStr : String;
- fmt : StringPtr;
- i : INTEGER;
- data : STRUCT name : e.STRPTR;
- perc : LONGINT;
- tlen : LONGINT;
- flen : LONGINT;
- lins : LONGINT;
- END;
- BEGIN
- data.name := SYS.ADR(OldName);
- data.tlen := TextLength;
- data.flen := FileLength;
- IF data.flen=0 THEN data.flen := ReadLength END;
- IF data.flen=0 THEN data.flen := 1 END;
- data.perc := TextLength * 100 DIV data.flen;
- data.lins := AnzLines-1;
- fmt := LocStr(MSGINFOFMT);
- e.OldRawDoFmt(fmt^,SYS.ADR(data),StuffChar,SYS.ADR(IStr));
- IStr[0] := 7X; IF depth<2 THEN IStr[0] := 2X END;
- i := SHORT(str.Length(IStr));
- REPEAT IStr[i] := 20X; INC(i) UNTIL (i>=LEN(IStr)-2) OR (i>=NumColumns+2);
- IStr[i] := 0X;
- CopyToWriteText(SYS.ADR(IStr));
- AddBottomLine(SYS.ADR(writeText),Fast);
- Info := w;
- Scroll := f;
- END ShowInfo;
-
-
- PROCEDURE Help; (* executed when HELP or H is pressed *)
-
- CONST
- num = 25;
-
- VAR
- i,j : INTEGER;
- help : ARRAY num OF StringPtr;
- fmt : StringPtr;
- data : StringPtr;
- h1 : String;
-
- BEGIN
- data := SYS.ADR(Version);
- fmt := LocStr(MSGH1);
- e.OldRawDoFmt(fmt^,SYS.ADR(data),StuffChar,SYS.ADR(h1));
- help[ 0] := SYS.ADR(h1);
- help[ 1] := SYS.ADR("");
- help[ 2] := LocStr(MSGH2);
- help[ 3] := LocStr(MSGH3);
- help[ 4] := LocStr(MSGH4);
- help[ 5] := LocStr(MSGH5);
- help[ 6] := LocStr(MSGH6);
- help[ 7] := LocStr(MSGH7);
- help[ 8] := LocStr(MSGH8);
- help[ 9] := LocStr(MSGH9);
- help[10] := LocStr(MSGH10);
- help[11] := LocStr(MSGH11);
- help[12] := LocStr(MSGH12);
- help[13] := LocStr(MSGH13);
- help[14] := LocStr(MSGH24);
- help[15] := LocStr(MSGH14);
- help[16] := LocStr(MSGH23);
- help[17] := LocStr(MSGH15);
- help[18] := LocStr(MSGH16);
- help[19] := LocStr(MSGH17);
- help[20] := LocStr(MSGH18);
- help[21] := SYS.ADR("");
- help[22] := LocStr(MSGH19);
- help[23] := LocStr(MSGH21);
- help[24] := LocStr(MSGH22);
- ClearDisplay();
- j := (NumLines - num) DIV 2; IF j<0 THEN j:=0 END;
- i := 0;
- WHILE (i<num) & (i+j<NumLines) DO
- WriteTo(help[i],j+i);
- INC(i);
- END;
- LOOP
- e.WaitPort(Window.userPort);
- MyMsgPtr := e.GetMsg(Window.userPort);
- IF (LONGSET{I.rawKey,I.mouseButtons}*MyMsgPtr.class#LONGSET{}) & (MyMsgPtr.code<128) THEN EXIT END;
- e.ReplyMsg(MyMsgPtr);
- END;
- e.ReplyMsg(MyMsgPtr);
- BottomLine := TopLine;
- NewDisplay
- END Help;
-
-
- PROCEDURE Bottom; (* executed when END or B is pressed *)
-
- BEGIN
- WaitAllRead;
- BottomLine := LastLine;
- NewDisplay
- END Bottom;
-
-
- PROCEDURE Space(): BOOLEAN; (* executed if space or LMB is pressed *)
- (* IF result=w THEN EXIT END *)
-
- BEGIN
- IF (MyFile=NIL) & (BottomLine.next=NIL) THEN (* End of file? *)
- IF wasInfo THEN RETURN w END;
- ShowInfo(Shift);
- ELSE
- IF Down THEN
- Scroll := ~Scroll;
- IF ~Scroll THEN ShowInfo(Fast) END;
- ELSE
- Down := w;
- Scroll := w;
- END;
- Fast := Shift;
- END;
- RETURN f;
- END Space;
-
-
- PROCEDURE BackSpace; (* executed if backspace or RMB is pressed *)
-
- BEGIN
- Fast := Shift;
- Scroll := Down OR ~Scroll;
- Down := f
- END BackSpace;
-
-
- BEGIN
- (* $IF SmallData *)
- SYS.SETREG(13,e.AbsExecBase.thisTask.userData);
- (* $END *)
-
- (* $IFNOT ClearVars *)
- Find[0] := 0X; FindStr[0] := 0X; Goto[0] := 0X;
- (* $END *)
-
- Down := w;
-
- SYS.SETREG(0,e.AllocSignal(Window.userPort.sigBit));
- Window.userPort.sigTask := e.FindTask(NIL);
-
- showSigBit := e.AllocSignal(-1);
- showSig := LONGSET{showSigBit};
-
- e.Signal(Me,mySig);
- SYS.SETREG(0,e.Wait(showSig));
-
- LOOP
-
- IF NewDisp THEN NewDisp := f; NewDisplay END;
-
- (*------ Type Text: ------*)
-
- LOOP
- IF Scroll THEN
- IF Down THEN
- ScrollDown(Fast);
- Scroll := (MyFile#NIL) OR (BottomLine.next#NIL);
- ELSE
- ScrollUp(Fast);
- Scroll := (TopLine.prev#NIL) & (TopLine.prev.prev#NIL);
- END;
- ELSE
- MakeScroll(f,f,w);
- e.WaitPort(Window.userPort);
- END;
-
- MyMsgPtr := e.GetMsg(Window.userPort);
-
- IF MyMsgPtr # NIL THEN
- IF ~(I.inactiveWindow IN MyMsgPtr.class) THEN EXIT END;
- e.ReplyMsg(MyMsgPtr);
- I.OldModifyIDCMP(Window,MyIdcmp-LONGSET{I.mouseButtons});
- e.WaitPort(Window.userPort);
- I.OldModifyIDCMP(Window,MyIdcmp);
- END;
-
- END;
-
- Code := MyMsgPtr.code;
- Class := MyMsgPtr.class;
- Qualifier := MyMsgPtr.qualifier;
-
- e.ReplyMsg(MyMsgPtr);
-
- Shift := {ie.lShift,ie.rShift,ie.capsLock} * Qualifier # {};
- Alt := {ie.lAlt ,ie.rAlt} * Qualifier # {};
- Sync := ~ (ie.control IN Qualifier);
-
- IF ~Sync THEN Shift := w END;
-
-
- IF ((I.rawKey IN Class) & (Code<80H)) OR
- ((I.mouseButtons IN Class) & ({ie.leftButton,ie.rightButton}*Qualifier#{}))
- THEN
- wasInfo := f;
- IF Info THEN DelLine(Shift); wasInfo := w; END;
- END;
-
-
- IF I.mouseButtons IN Class THEN
-
- IF (ie.leftButton IN Qualifier) & Space() THEN EXIT
- ELSIF ie.rightButton IN Qualifier THEN BackSpace END;
-
- ELSIF I.closeWindow IN Class THEN
- EXIT;
-
- ELSIF (I.newSize IN Class) THEN
- Scroll := f;
- zoomed := w;
- IF Window.height = initialheight THEN
- zoomed := f;
- BottomLine := TopLine;
- NewDisplay;
- END;
-
- ELSIF (I.rawKey IN Class) & (Code<80H) & ~zoomed THEN
-
- CASE Code OF
-
- | SPACE: IF Space() THEN EXIT END (* Space *)
-
- | BS: BackSpace (* BackSpace *)
-
- | DOWN,NK2,NK3: (* Down *)
-
- IF (MyFile=NIL) & (BottomLine.next=NIL) THEN
- I.DisplayBeep(NIL)
- ELSE
- IF Shift & (Code # NK3) THEN
- Scroll := ~Down OR ~Scroll OR ~Fast;
- Fast := w; Down := w;
- ELSE
- IF Alt OR (Code=NK3) THEN
- IF oldstyle THEN
- i := NumLines-1;
- REPEAT
- ScrollDown(w);
- DEC(i);
- UNTIL i=0;
- ELSE
- IF BottomLine.next#NIL THEN BottomLine := BottomLine.next END;
- NewDisplay;
- END;
- ELSE
- ScrollDown(w);
- END;
- Scroll := f;
- END;
- END;
-
- | UP,NK8,NK9: (* Up *)
-
- IF (TopLine.prev=NIL) OR (TopLine.prev.prev=NIL) THEN
- I.DisplayBeep(NIL)
- ELSE
- IF Shift & (Code # NK9) THEN
- Scroll := Down OR ~Scroll OR ~Fast;
- Fast := w; Down := f;
- ELSE
- IF Alt OR (Code=NK9) THEN
- i := NumLines-1;
- IF oldstyle THEN
- REPEAT
- ScrollUp(w);
- DEC(i);
- UNTIL i=0;
- ELSE
- (*IF TopLine.prev#NIL THEN*)
- BottomLine := TopLine;
- WHILE (i>0) & (BottomLine.prev#NIL) DO
- BottomLine := BottomLine.prev;
- DEC(i);
- END;
- NewDisplay;
- (*END;*)
- END;
- ELSE
- ScrollUp(w);
- END;
- Scroll := f;
- END;
- END;
-
- | CR,ENTER: ScrollDown(f); Scroll := f; (* CR *)
-
- | NK7: BottomLine := FirstLine; NewDisplay (* Home *)
-
- | NK1: Bottom (* End *)
-
- | F1..F10: (* F1..F10 *)
-
- i := Code-F1;
- IF ~ Shift & (TextMarkers[i]#NIL) THEN
- BottomLine := TextMarkers[i];
- NewDisplay;
- ELSE
- TextMarkers[i] := TopLine;
- END
-
- | NK0: IF ~wasInfo THEN ShowInfo(Shift) END; (* NK 0 *)
-
- | HELP: Help (* Help *)
-
- | ESC: EXIT (* Quit *)
-
- | NK5: IF wasInfo OR fastquit THEN EXIT ELSE ShowInfo(Shift)END; (* safe Quit *)
-
- ELSE
-
- IF Code<40H THEN (* examine vanilla keycode: *)
-
- chr := KeyMap[Code];
-
- CASE chr OF
-
- | "t": BottomLine := FirstLine; NewDisplay (* Home *)
-
- | "b": Bottom; (* End *)
-
- | "f","n","p": (* Find, Next, Previous *)
-
- IF chr="f" THEN
- caseDelta := 32; IF Shift THEN caseDelta := 0 END;
- GetString(Find,f,w);
- FindLine := NIL; flen := 0;
- LOOP
- FindStr[flen] := Find[flen];
- CASE FindStr[flen] OF
- "a".."z","à".."ö","ø".."þ": DEC(FindStr[flen],caseDelta) |
- 0X: EXIT;
- ELSE
- END;
- INC(flen);
- END;
- CalcSkipTab;
- END;
- found := f;
- IF FindStr[0]#0X THEN
- Busy;
- i := NumLines;
- IF FindLine # NIL THEN FindLine := FindLine.next END;
- WHILE (i>0) & (BottomLine#NIL) & (BottomLine#FindLine) DO
- BottomLine := BottomLine.prev; DEC(i);
- END;
- IF (BottomLine # FindLine) OR (BottomLine=NIL) THEN
- BottomLine := TopLine
- END;
- IF chr # "p" THEN (* next *)
- WHILE (BottomLine # NIL) & ~ Search() DO
- SYS.SETREG(0,TryBottomnext());
- BottomLine := BottomLine.next;
- END;
- ELSE (* previous *)
- IF BottomLine.prev#NIL THEN BottomLine:=BottomLine.prev END;
- REPEAT
- BottomLine := BottomLine.prev
- UNTIL (BottomLine=NIL) OR Search();
- END;
- IF BottomLine#NIL THEN
- li := NumLines DIV 2;
- WHILE (li>0) & (BottomLine.prev#NIL) DO BottomLine := BottomLine.prev; DEC(li) END;
- END;
- UnBusy;
- END;
-
- IF ~ found THEN
- I.DisplayBeep(NIL);
- BottomLine := TopLine;
- END;
- NewDisplay;
- IF found THEN UnHiLite END;
-
- | "w","c": (* write block *)
- IF (TextMarkers[0]#NIL) & (TextMarkers[1]#NIL) & ~print & ~save THEN
- savefrom := 0; savesize := 0;
- l := TextMarkers[0].prev; WHILE l.prev#NIL DO l := l.prev; INC(savefrom,l.len) END;
- l := TextMarkers[1].prev; WHILE l#NIL DO INC(savesize,l.len); l := l.prev END;
- l := TextMarkers[1]; i := NumLines; WHILE (i>1) & (l#NIL) DO DEC(i); INC(savesize,LONG(l.len)); l := l.next END;
- DEC(savesize,savefrom);
- IF savesize>0 THEN
- IF chr="c" THEN copy := w ELSE
- GetString(WriteName,f,w);
- copy := f;
- END;
- WaitAllRead; save := w; e.Signal(Me,mySig);
- END
- END
-
- | "o","e": (* Print, Edit *)
-
- IF Shift & Alt & ~print & ~save THEN
- nameptr := SYS.ADR(Name);
- IF chr="o" THEN
- e.OldRawDoFmt('Type "%s" to PRT:',SYS.ADR(nameptr),StuffChar,SYS.ADR(PStr));
- ELSE
- e.OldRawDoFmt(editcmd,SYS.ADR(nameptr),StuffChar,SYS.ADR(PStr));
- END;
- WaitAllRead; print := w; e.Signal(Me,mySig);
- END
-
- | "l": (* Load Text *)
-
- ClearDisplay;
- NewText := w; e.Signal(Me,mySig);
- REPEAT UNTIL (showSigBit IN e.Wait(showSig)) & ~ NewText |
-
- | "g": (* goto *)
-
- GetString(Goto,w,w);
- li := SHORT(StrInfo.longInt);
- Busy;
- BottomLine := FirstLine;
- WHILE (li >= 0) & TryBottomnext() DO
- BottomLine := BottomLine.next;
- DEC(li)
- END;
- UnBusy;
- NewDisplay
-
- | "h": Help (* Help *)
-
- | "q","x": IF wasInfo OR fastquit THEN EXIT ELSE ShowInfo(Shift) END; (* safe Quit *)
-
- ELSE END;
-
- END; (* IF Code<40H THEN *)
-
- END; (* CASE Code OF *)
-
- END; (* IF I.rawKey IN Class THEN *)
-
- END; (* LOOP *)
-
- Done := w;
- e.Signal(Me,mySig);
- LOOP SYS.SETREG(0,e.Wait(LONGSET{})) END;
-
- END ShowProc;
-
- (* $Debug= *)
-
-
- (*-------------------------- File Requester: ----------------------------*)
-
-
- PROCEDURE FileReq(VAR Name: String);
-
- CONST
- aslTag = u.user + 80000H;
- taghail = aslTag + 1;
- window = aslTag + 2;
- leftEdge = aslTag + 3;
- topEdge = aslTag + 4;
- width = aslTag + 5;
- height = aslTag + 6;
- hookFunc = aslTag + 7;
- file = aslTag + 8;
- dir = aslTag + 9;
- pattern = aslTag + 10;
- funcFlags = aslTag + 20;
- screen = aslTag + 40;
- sleepWindow=aslTag + 43;
-
- fiDir = u.user + 50;
- patGad = 0;
-
- TYPE
- FileRequesterPtr = UNTRACED POINTER TO FileRequester;
-
- FileRequester = STRUCT
- hail : StringPtr;
- ddef : StringPtr;
- ddir : StringPtr;
- wind : I.WindowPtr;
- funcFlags : SHORTSET;
- flags2 : SHORTSET;
- function : PROCEDURE;
- reserved2 : LONGINT;
- END;
- VAR
- fr: FileRequesterPtr;
- pub,scr: I.ScreenPtr;
- i,j: INTEGER;
- res: BOOLEAN;
- screenTag: LONGINT;
-
- PROCEDURE AllocAslRequest {asl,-48} (type{0}: LONGINT; tag{8}..: e.APTR): FileRequesterPtr;
- PROCEDURE FreeAslRequest {asl,-54} (fr{8}: FileRequesterPtr);
- PROCEDURE RequestFile {asl,-42} (fr{8}: FileRequesterPtr): e.APTR;
-
- BEGIN
- j := SHORT(str.Length(Name));
- WHILE (j>0) & (Name[j]#":") & (Name[j]#"/") DO DEC(j) END;
- IF j=0 THEN j := -1 END;
- i := 0;
- WHILE i<=j DO Dirname[i] := Name[i]; INC(i) END; Dirname[i] := 0X;
- j := 0;
- REPEAT Filename[j] := Name[i]; INC(j); INC(i) UNTIL Name[i-1]=0X;
-
- IF asl=NIL THEN
- asl := e.OpenLibrary("asl.library",36);
- IF asl=NIL THEN
- Request("Can't open asl.library")
- END;
- END;
-
- IF (Window # NIL) & (asl.version >= 38) THEN
- screenTag := screen;
- scr := Window.wScreen;
- ELSE
- screenTag := u.ignore;
- scr := NIL;
- pub := I.LockPubScreen(NIL);
- IF pub # NIL THEN
- I.ScreenToFront(pub);
- I.UnlockPubScreen(NIL,pub);
- END;
- END;
-
- fr := AllocAslRequest(0, screenTag,scr,
- taghail, SYS.ADR(MuchText),
- file, SYS.ADR(Filename),
- dir, SYS.ADR(Dirname),
- pattern, SYS.ADR(Pattern),
- funcFlags,ASH(1,patGad),
- u.done);
- IF fr=NIL THEN Request(LocStr(MSGOOM)^) END;
-
- res := RequestFile(fr) # NIL;
-
- IF res THEN
- Filename := fr.ddef^;
- Dirname := fr.ddir^;
- END;
- FreeAslRequest(fr);
- IF ~res THEN HALT(d.ok) END;
-
- Name := Dirname;
- i := SHORT(str.Length(Name));
- IF (i>0) THEN
- CASE Name[i-1] OF "/",":": ELSE
- Name[i] := "/"; INC(i);
- END;
- END;
- j := 0;
- LOOP
- Name[i] := Filename[j];
- IF (Name[i]=0X) OR (i=255) THEN EXIT END;
- INC(i);
- INC(j);
- END;
- Name[i] := 0X;
- IF Window # NIL THEN
- I.ScreenToFront(Window.wScreen);
- I.ActivateWindow(Window);
- END;
- END FileReq;
-
-
- (*-------------------------- Decrunch: ----------------------------*)
-
-
- PROCEDURE DirExists(name: ARRAY OF CHAR): BOOLEAN; (* $CopyArrays- *)
- VAR lock: d.FileLockPtr;
- result: BOOLEAN;
- oldwp: e.APTR;
- BEGIN
- result := f;
- oldwp := Me.windowPtr;
- Me.windowPtr := -1;
- lock := d.Lock(name,d.sharedLock);
- IF lock # NIL THEN
- result := w;
- d.UnLock(lock)
- END;
- Me.windowPtr := oldwp;
- RETURN result
- END DirExists;
-
-
- PROCEDURE Decrunch;
-
- CONST
- tagBase = u.user + ORD("X")*256 + ORD("P");
- inName = tagBase+01H;
- inFH = tagBase+02H;
- outName = tagBase+10H;
- password = tagBase+24H;
- getError = tagBase+25H;
- shortError = tagBase+31H;
- typePacked = 1;
- flagsPassword = 0;
-
- TYPE
- XpkFib = STRUCT
- type : LONGINT; (* Unpacked, packed, archive? *)
- uLen : LONGINT;
- cLen : LONGINT;
- nLen : LONGINT;
- uCur : LONGINT;
- cCur : LONGINT;
- id : LONGINT;
- packer : ARRAY 6 OF CHAR;
- subVersion : INTEGER;
- masVersion : INTEGER;
- flags : LONGSET;
- head : ARRAY 16 OF CHAR;
- ratio : LONGINT;
- reserved : ARRAY 8 OF LONGINT;
- END;
-
- VAR
- file: d.FileHandlePtr;
- err: LONGINT;
- xpkFib: XpkFib;
- errBuf: ARRAY 81 OF CHAR;
-
- PROCEDURE ExamineTags {xpk,-36}(VAR fib{8} : XpkFib;
- tag1{9}.. : e.APTR): LONGINT;
- PROCEDURE UnpackTags {xpk,-48}(tag1{8}.. : e.APTR): LONGINT;
-
- BEGIN
- Decrunched := f;
- OldName := Name;
- IF stdin THEN RETURN END;
-
- IF DirExists("T:") THEN Name := "T:" ELSE Name := "RAM:" END;
-
- e.OldRawDoFmt("Decrunched.%lx",SYS.ADR(meInt),StuffChar,SYS.ADR(Name[str.Length(Name)]));
-
- IF xpk=NIL THEN
- xpk := e.OpenLibrary("xpkmaster.library",1);
- END;
- IF xpk#NIL THEN
- err := ExamineTags(xpkFib,inFH,SYS.VAL(LONGINT,MyFile),u.done);
- IF (err#0) & (err#-20) THEN
- Request(LocStr(MSGOOM)^)
- END;
- IF (err=-20) OR (xpkFib.type#typePacked) THEN
- Name := OldName;
- RETURN
- END;
- IF flagsPassword IN xpkFib.flags THEN GetString(Password,f,f) END;
- Busy;
- err := UnpackTags(inFH, SYS.VAL(LONGINT,MyFile),
- outName, SYS.ADR(Name),
- password, SYS.ADR(Password),
- getError, SYS.ADR(errBuf),
- shortError, e.true,
- u.done);
- UnBusy;
- IF err#0 THEN Request(errBuf) END;
- file := d.Open(Name,d.oldFile);
- IF file#NIL THEN
- Decrunched := w;
- d.OldClose(MyFile);
- MyFile := file;
- RETURN
- ELSE
- Request(LocStr(MSGCOF)^);
- END;
- END;
- Name := OldName;
- END Decrunch;
-
-
- (*----------------- Screen Mode Requester: ------------------------*)
-
-
- PROCEDURE GetNode (VAR list: e.List; index: LONGINT): e.NodePtr;
- VAR n: e.NodePtr;
- BEGIN
- n := list.head;
- WHILE index > 0 DO
- IF n.succ=NIL THEN RETURN NIL END;
- n := n.succ;
- DEC(index);
- END;
- RETURN n;
- END GetNode;
-
-
- PROCEDURE ScreenModeReq (VAR displayID : LONGINT): INTEGER;
- CONST
- gadLISTVIEW = 1;
- gadBUTTONSave = 2;
- gadBUTTONUse = 3;
- gadBUTTONCancel= 4;
-
- Topaz80 = g.TextAttr(SYS.ADR("topaz.font"), 8, SHORTSET{}, SHORTSET{});
-
- TYPE
- MyNodePtr = UNTRACED POINTER TO MyNode;
- MyNode = STRUCT (node: e.Node)
- displayID: LONGINT;
- END;
-
- VAR
- ng : gt.NewGadget;
- gad,glist : I.GadgetPtr;
- Win : I.WindowPtr;
- pub : I.ScreenPtr;
- font : g.TextAttrPtr;
- width,height : INTEGER;
- txW,txH : INTEGER;
- result,index : INTEGER;
- firstindex : INTEGER;
- topborder : INTEGER;
- x1,x2,min : INTEGER;
- terminated : BOOLEAN;
- lvlist : e.List;
- lvSelectedTag : LONGINT;
- vi : e.APTR;
- imsg : I.IntuiMessagePtr;
- node : MyNodePtr;
- dispID : LONGINT;
- displayInfo : g.DisplayInfo;
- nameInfo : g.NameInfo;
-
-
- PROCEDURE StrLen (str: e.STRPTR; min: INTEGER): INTEGER;
- VAR it: I.IntuiText;
- len: INTEGER;
- BEGIN
- (* $IFNOT ClearVars *)
- len := 0;
- it.leftEdge := 0; it.topEdge := 0; it.frontPen := 0; it.backPen := 0;
- it.drawMode := SHORTSET{}; it.nextText := NIL;
- (* $END *)
- IF str#NIL THEN
- it.iTextFont := font; it.iText := str;
- len := I.IntuiTextLength(it);
- END;
- IF len > min THEN RETURN len ELSE RETURN min END;
- END StrLen;
-
- BEGIN
- (* $IFNOT ClearVars *)
- Win := NIL; vi := NIL; glist := NIL; pub := NIL; result := 0;
- (* $END *)
-
- LOOP
- pub := I.LockPubScreen(NIL); IF pub=NIL THEN EXIT END;
- vi := gt.GetVisualInfo(pub,u.done); IF vi =NIL THEN EXIT END;
- topborder := pub.wBorTop + pub.font.ySize + 1;
-
- font := pub.font;
- txW := pub.rastPort.txWidth; txH := pub.rastPort.txHeight;
- width := txW * 36 + 16; height := txH * 8 + 32;
- IF ((width+pub.wBorLeft+pub.wBorRight) > pub.width) OR ((height+topborder+pub.wBorBottom) > pub.height) THEN
- font := SYS.ADR(Topaz80);
- txW := 8; txH := 8;
- width := 8 * 36 + 16; height := 8 * 8 + 32;
- END;
- min := txW * 6;
-
- gad := gt.CreateContext(glist);
-
- ng.textAttr := font;
- ng.visualInfo := vi;
- ng.userData := NIL;
-
- ng.leftEdge := 16;
- ng.height := txH+4;
- ng.topEdge := topborder+height-ng.height-5;
- ng.gadgetText := LocStr(MSGSAVE);
- ng.width := StrLen(ng.gadgetText,min)+8;
- ng.gadgetID := gadBUTTONSave;
- ng.flags := LONGSET{};
- x1 := ng.leftEdge+ng.width;
-
- gad := gt.CreateGadget(gt.buttonKind, gad, ng, u.done);
-
- ng.gadgetText := LocStr(MSGCANCEL);
- ng.width := StrLen(ng.gadgetText,min)+8;
- ng.leftEdge := width-ng.width-8;
- ng.gadgetID := gadBUTTONCancel;
- x2 := ng.leftEdge;
-
- gad := gt.CreateGadget(gt.buttonKind, gad, ng, u.done);
-
- ng.gadgetText := LocStr(MSGUSE);
- ng.width := StrLen(ng.gadgetText,min)+8;
- ng.leftEdge := (x1+x2-ng.width) DIV 2;
- ng.gadgetID := gadBUTTONUse;
-
- gad := gt.CreateGadget(gt.buttonKind, gad, ng, u.done);
-
- lvlist.head := SYS.ADR(lvlist.tail);
- lvlist.tail := NIL;
- lvlist.tailPred := SYS.ADR(lvlist.head);
-
- index := 0;
- firstindex := -1;
- dispID := g.NextDisplayInfo(g.invalidID);
-
- WHILE dispID # g.invalidID DO
- IF (g.GetDisplayInfoData(NIL,displayInfo,SIZE(displayInfo),g.dtagDisp,dispID) > 0) &
- (displayInfo.notAvailable = 0) &
- (LONGSET{g.isHAM,g.isExtraHalfBrite,g.isDualPF} * displayInfo.propertyFlags = LONGSET{}) &
- (g.GetDisplayInfoData(NIL,nameInfo,SIZE(nameInfo),g.dtagName,dispID) > 0)
- THEN
- SYS.ALLOCATE(node);
- IF node # NIL THEN
- SYS.ALLOCATE(node.node.name);
- IF node.node.name # NIL THEN
- COPY(nameInfo.name,node.node.name^);
- node.displayID := dispID;
- e.AddTail(lvlist, node);
- IF dispID=displayID THEN firstindex := index END;
- INC(index);
- ELSE
- EXIT
- END;
- ELSE
- EXIT
- END;
- END;
- dispID := g.NextDisplayInfo(dispID);
- END;
-
- ng.leftEdge := 16;
- ng.topEdge := txH+8+topborder;
- ng.width := width-25;
- ng.height := txH*6+15;
- ng.gadgetText := LocStr(MSGCHOOSESM);
- ng.gadgetID := gadLISTVIEW;
- ng.flags := LONGSET{gt.highLabel,gt.placeTextAbove};
-
- IF firstindex >= 0 THEN lvSelectedTag := gt.lvSelected
- ELSE lvSelectedTag := u.ignore END;
-
- gad := gt.CreateGadget(gt.listViewKind, gad, ng,
- gt.lvLabels, SYS.ADR(lvlist),
- gt.lvShowSelected, NIL,
- gt.lvScrollWidth, txW*2,
- I.layoutaSpacing, 2,
- lvSelectedTag, firstindex,
- u.done);
- IF gad = NIL THEN EXIT END;
-
- Win := I.OpenWindowTagsA(NIL,
- I.waLeft, 30,
- I.waTop, 20,
- I.waInnerWidth, width,
- I.waInnerHeight, height,
- I.waTitle, SYS.ADR(MuchText),
- I.waFlags, LONGSET{I.activate,I.windowDrag,I.windowDepth,I.simpleRefresh,I.rmbTrap},
- I.waIDCMP, gt.listViewIDCMP+gt.buttonIDCMP+LONGSET{I.gadgetUp,I.refreshWindow},
- I.waPubScreen, pub,
- I.waGadgets, glist,
- u.done);
- IF Win = NIL THEN EXIT END;
- gt.RefreshWindow(Win, NIL);
-
- dispID := displayID;
- terminated := f;
-
- WHILE ~terminated DO
- e.WaitPort(Win.userPort);
- LOOP
- IF terminated THEN EXIT END;
- imsg := gt.GetIMsg(Win.userPort);
- IF imsg=NIL THEN EXIT END;
- gad := imsg.iAddress;
-
- IF I.gadgetUp IN imsg.class THEN
- CASE gad.gadgetID OF
- | gadBUTTONSave: result := 1; displayID := dispID; terminated := w;
- | gadBUTTONUse: result := 2; displayID := dispID; terminated := w;
- | gadBUTTONCancel: terminated := w;
- | gadLISTVIEW: node := GetNode(lvlist,imsg.code);
- IF node # NIL THEN dispID := node.displayID END;
- ELSE
- END;
- END;
-
- IF I.refreshWindow IN imsg.class THEN
- gt.BeginRefresh(Win);
- gt.EndRefresh(Win, I.LTRUE);
- END;
-
- gt.ReplyIMsg(imsg);
-
- END;
- END;
-
- EXIT
- END;
-
- IF Win # NIL THEN I.CloseWindow(Win) END;
- IF glist # NIL THEN gt.FreeGadgets(glist) END;
- IF vi # NIL THEN gt.FreeVisualInfo(vi) END;
- IF pub # NIL THEN I.UnlockPubScreen(NIL,pub) END;
-
- RETURN result;
- END ScreenModeReq;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE SavePrefs;
-
- PROCEDURE SavePrefsName(name: StringPtr);
- VAR file: d.FileHandlePtr;
- l: LONGINT;
- BEGIN
- file := d.Open(name^,d.newFile);
- IF file # NIL THEN
- SYS.SETREG(0,d.Write(file,"FORM",4));
- l := 16;
- SYS.SETREG(0,d.Write(file,l,4));
- SYS.SETREG(0,d.Write(file,"MUMO",4));
- SYS.SETREG(0,d.Write(file,"DPID",4));
- l := 4;
- SYS.SETREG(0,d.Write(file,l,4));
- SYS.SETREG(0,d.Write(file,id,4));
- d.OldClose(file);
- END;
- END SavePrefsName;
-
- BEGIN
- IF DirExists("ENV:") THEN
- SavePrefsName(SYS.ADR("ENV:MuchMore.prefs"))
- END;
- IF DirExists("ENVARC:") THEN
- SavePrefsName(SYS.ADR("ENVARC:MuchMore.prefs"))
- END;
- END SavePrefs;
-
-
- (*-------------------------------------------------------------------------*)
-
-
- PROCEDURE LoadPrefs;
-
- VAR file: d.FileHandlePtr;
- l,i,s: LONGINT;
- buf: ARRAY 80 OF CHAR;
- ok: BOOLEAN;
-
- BEGIN
- file := NIL;
- IF DirExists("PROGDIR:") THEN
- file := d.Open("PROGDIR:MuchMore.prefs",d.oldFile);
- END;
- IF (file=NIL) & DirExists("ENV:") THEN
- file := d.Open("ENV:MuchMore.prefs",d.oldFile);
- END;
- IF file # NIL THEN
- LOOP
- IF (d.Read(file,i,4) <= 0) OR
- (i # SYS.VAL(LONGINT,"FORM")) OR
- (d.Read(file,s,4) <= 0) OR
- (d.Read(file,i,4) <= 0) OR
- (i # SYS.VAL(LONGINT,"MUMO")) THEN EXIT END;
- WHILE w DO
- IF (d.Read(file,i,4) <= 0) OR
- (d.Read(file,s,4) <= 0) THEN EXIT END;
- IF ODD(s) THEN INC(s) END;
- IF (s=4) & (i=SYS.VAL(LONGINT,"DPID")) THEN
- SYS.SETREG(0,d.Read(file,id,4));
- ELSE
- IF s < 0 THEN EXIT END;
- SYS.SETREG(0,d.Seek(file,s,d.current));
- END;
- END;
-
- EXIT;
- END;
- d.OldClose(file);
- END;
- IF (d.GetVar("EDITOR",buf,SIZE(buf),LONGSET{})>0) THEN
- COPY(buf,editcmd);
- END;
- END LoadPrefs;
-
-
- (*------------------------ Get Tooltypes: --------------------------*)
-
-
- PROCEDURE ParseIcon(icon: DiskObjectPtr);
- VAR tt: StringPtr;
-
- BEGIN
- IF icon # NIL THEN
- tt := FindToolType(icon.toolTypes,"PALETTE"); IF (tt # NIL) THEN COPY(tt^,Pens) END;
- tt := FindToolType(icon.toolTypes,"EXTRASPACE"); IF (tt # NIL) THEN spacing := SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"FONT"); IF (tt # NIL) THEN COPY(tt^,FontName) END;
- tt := FindToolType(icon.toolTypes,"EDITOR"); IF (tt # NIL) THEN COPY(tt^,editcmd) END;
- tt := FindToolType(icon.toolTypes,"OLDSTYLE"); IF (tt # NIL) THEN oldstyle := (MatchToolValue(tt^,"TRUE")) END;
- tt := FindToolType(icon.toolTypes,"FASTQUIT"); IF (tt # NIL) THEN fastquit := (MatchToolValue(tt^,"TRUE")) END;
- tt := FindToolType(icon.toolTypes,"INTERLEAVED");IF (tt # NIL) THEN interleaved := (MatchToolValue(tt^,"TRUE")) END;
- tt := FindToolType(icon.toolTypes,"PLANES"); IF (tt # NIL) THEN depth := SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"TABWIDTH"); IF (tt # NIL) THEN tabw := SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"PUBSCREEN"); IF (tt # NIL) THEN COPY(tt^,pubscreenname) END;
- tt := FindToolType(icon.toolTypes,"TOOLPRI"); IF (tt # NIL) THEN taskpri := SHORT(SHORT(StrToInt(tt,10))) END;
- tt := FindToolType(icon.toolTypes,"SCROLLMODE"); IF (tt # NIL) THEN scrollmode := SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"LEFT"); IF (tt # NIL) THEN left := SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"TOP"); IF (tt # NIL) THEN top := SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"WIDTH"); IF (tt # NIL) THEN width := SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"HEIGHT"); IF (tt # NIL) THEN height:= SHORT(StrToInt(tt,10)) END;
- tt := FindToolType(icon.toolTypes,"WINDOW"); IF (tt # NIL) THEN win := (MatchToolValue(tt^,"TRUE")) END;
- FreeDiskObject(icon);
- END;
- END ParseIcon;
-
-
- (*------------------------------ MAIN: ----------------------------------*)
-
- BEGIN
-
- (*------ Init: ------*)
-
- mySigBit := -1;
- Me := SYS.VAL(d.ProcessPtr,ol.Me);
- meInt := SYS.VAL(LONGINT,Me);
- OldDir := Me.currentDir;
- oldpri := Me.task.node.pri; taskpri := oldpri;
- WriteName := "PRT:";
- MemIndex := ChunkSize;
- Sync := w;
- FontSize := 8;
- Pattern := "~(#?.info)";
- editcmd := 'C:Ed';
- id := g.invalidID;
- tabw := 8;
- depth := 2;
- left := 0;
- top := 0;
- width := 640;
- height := 200;
- scrollmode := 1;
-
-
- IF (I.base.libNode.version < 37) OR (g.base.libNode.version < 37) THEN
- HALT(d.fail);
- END;
-
-
- mySigBit := e.AllocSignal(-1);
- IF mySigBit<0 THEN HALT(d.fail) END;
- mySig := LONGSET{mySigBit};
-
- iconBase := e.OpenLibrary("icon.library",0);
- diskFontBase := e.OpenLibrary("diskfont.library",0);
-
-
- IF loc.base # NIL THEN
- catalog := loc.OpenCatalog(NIL,"muchmore.catalog",u.end);
- END;
-
- ol.OutOfMemHandler := OutOfMemHandler;
-
- INCL(ol.MemReqs,e.public);
-
- ol.New(ShowStack,ShowStackSize);
- NEW(ShowTask);
- NEW(FileInfo);
- NEW(ievent);
- NEW(conreq);
- NEW(Buffer);
-
- INCL(ol.MemReqs,e.chip);
- NEW(busyPointer);
- e.CopyMem(TheBusyPointer,busyPointer^,SIZE(busyPointer^));
- EXCL(ol.MemReqs,e.chip);
-
- (*------ Setup: ------*)
-
- NEW(FirstLine);
- (*FirstLine.size := 0;
- FirstLine.text[0] := 0X; *)
-
- (*------ Start: ------*)
-
- LoadPrefs;
-
- IF ol.wbStarted THEN
-
- wbm := ol.wbenchMsg;
- IF iconBase # NIL THEN
- j := SHORT(wbm.numArgs); IF j>2 THEN j := 2 END;
- FOR i := 0 TO j-1 DO
- SYS.SETREG(0,d.CurrentDir(wbm.argList[i].lock));
- nameptr := wbm.argList[i].name;
- icon := GetDiskObject(nameptr^);
- IF icon=NIL THEN
- IF d.base.lib.version >= 37 THEN
- SYS.SETREG(0,d.CurrentDir(d.GetProgramDir()));
- icon := GetDiskObject(nameptr^);
- END;
- IF icon=NIL THEN
- clock := d.Lock("C:",d.sharedLock);
- SYS.SETREG(0,d.CurrentDir(clock));
- icon := GetDiskObject(nameptr^);
- END;
- END;
- ParseIcon(icon);
- END;
- END; (* IF iconBase#NIL *)
-
- IF wbm.numArgs >= 2 THEN
- ArgPtr := wbm.argList^[1].name; Name := ArgPtr^;
- SYS.SETREG(0,d.CurrentDir(wbm.argList^[1].lock));
- ELSE
- SYS.SETREG(0,d.CurrentDir(wbm.argList^[0].lock));
- FileReq(Name)
- END;
- IF clock # NIL THEN d.UnLock(clock) END;
-
- ELSE (* CLI started *)
-
- stdin := (Me.cis # Me.cli.standardInput); (* Input redirected? *)
-
- IF iconBase # NIL THEN
- progdir := d.GetProgramDir();
- IF progdir = NIL THEN
- progdir := d.Lock("C:",d.sharedLock); cLocked := w;
- END;
- oldcd := d.CurrentDir(progdir);
- IF d.GetProgramName(Name,LEN(Name)) THEN
- nameptr := d.FilePart(Name);
- icon := GetDiskObject(nameptr^);
- ParseIcon(icon);
- Name[0] := 0X;
- END;
- oldcd := d.CurrentDir(oldcd);
- IF cLocked THEN d.UnLock(progdir) END;
- END;
-
- rd := d.ReadArgs("B=PLANES/N/K,C=PALETTE/K,D=DISPMODEREQ/S,E=EDITOR/K,F=FONT/K,I=INTERLEAVED/S,O=OLDSTYLE/S,P=TOOLPRI/N/K,Q=FASTQUIT/S,S=SCROLLMODE/N/K,T=TABWIDTH/N/K,U=PUBSCREEN/K,X=EXTRASPACE/N/K,W=WINDOW/S,WL=LEFT/N/K,WT=TOP/N/K,WW=WIDTH/N/K,WH=HEIGHT/N/K,FILE",args,NIL);
- IF rd=NIL THEN
- SYS.SETREG(0,d.PrintFault(d.IoErr(),NIL));
- HALT(d.warn)
- END;
- IF args.b # NIL THEN depth := SHORT(args.b^) END;
- IF args.c # NIL THEN COPY(args.c^,Pens) END;
- IF args.d # NIL THEN modeReq := w END;
- IF args.e # NIL THEN COPY(args.e^,editcmd) END;
- IF args.f # NIL THEN COPY(args.f^,FontName) END;
- IF args.i # NIL THEN interleaved := w END;
- IF args.o # NIL THEN oldstyle := w END;
- IF args.q # NIL THEN fastquit := w END;
- IF args.p # NIL THEN taskpri := SHORT(SHORT(args.p^)) END;
- IF args.s # NIL THEN scrollmode := SHORT(args.s^) END;
- IF args.t # NIL THEN tabw := SHORT(args.t^) END;
- IF args.u # NIL THEN COPY(args.u^,pubscreenname) END;
- IF args.x # NIL THEN spacing := SHORT(args.x^) END;
- IF args.w # NIL THEN win := w END;
-
- IF args.wl # NIL THEN left := SHORT(args.wl^) END;
- IF args.wt # NIL THEN top := SHORT(args.wt^) END;
- IF args.ww # NIL THEN width := SHORT(args.ww^) END;
- IF args.wh # NIL THEN height:= SHORT(args.wh^) END;
-
- IF args.file # NIL THEN COPY(args.file^,Name); stdin := f END;
- d.FreeArgs(rd); rd := NIL;
- END;
-
- IF pubscreenname # "" THEN
- win := w;
- END;
-
- IF taskpri#oldpri THEN SYS.SETREG(0,e.SetTaskPri(Me,taskpri)) END;
-
- IF tabw < 1 THEN tabw := 1 END;
-
- IF depth < 1 THEN depth := 1 END;
- IF depth > 2 THEN depth := 2 END;
-
- IF str.Occurs(editcmd,"%s")<0 THEN str.Append(editcmd,' "%s"') END;
-
- IF FontName[0]#0X THEN
- i := 0;
- j := SHORT(str.Length(FontName));
- LOOP
- IF i >= j THEN EXIT END;
- IF FontName[i]='/' THEN
- FontName[i] := 0X;
- FontSize := SHORT(StrToInt(SYS.ADR(FontName[i+1]),10));
- j := i;
- EXIT
- END;
- INC(i);
- END;
- IF j<LEN(FontName)-6 THEN
- e.CopyMem(".font",FontName[j],6);
- END;
- END;
-
- IF Pens[0]#0X THEN
- ci := 0;
- chptr := SYS.ADR(Pens);
- Pens[LEN(Pens)-1] := 0X;
- LOOP
- Cols[ci] := SHORT(StrToInt(SYS.VAL(StringPtr,chptr),16));
- INC(ci); IF ci=4 THEN EXIT END;
- WHILE (chptr^#0X) & (chptr^#",") DO
- chptr:=SYS.VAL(e.APTR,SYS.VAL(LONGINT,chptr)+1)
- END;
- IF chptr^="," THEN
- chptr:=SYS.VAL(e.APTR,SYS.VAL(LONGINT,chptr)+1)
- ELSE
- EXIT
- END;
- END;
- END;
-
- IF FontSize>50 THEN FontSize := 50 END;
- IF FontSize< 5 THEN FontSize := 5 END;
-
- IF spacing< 0 THEN spacing := 0 END;
- IF spacing>20 THEN spacing := 20 END;
-
- IF width <150 THEN width := 150 END;
- IF height< 70 THEN height := 70 END;
-
- IF modeReq & (gt.base#NIL) THEN
- IF ScreenModeReq(id) = 1 THEN SavePrefs END;
- END;
-
- (*------ Open File: ------*)
-
- IF stdin THEN
- MyFile := d.Input();
- Name := "STDIN";
- ELSE
- LOOP
- MyFile := d.Open(Name,d.oldFile);
- IF MyFile#NIL THEN EXIT END;
- FileReq(Name)
- END;
- END;
-
- (*----- Open Display: -----*)
-
- OpenDisplay;
-
- (*------ Get KeyMap: ------*)
-
- IF e.OpenDevice("console.device",-1,conreq,LONGSET{})#0 THEN HALT(d.fail) END;
- console := conreq.device;
- con.base := console;
- (*ievent.nextEvent := NIL;
- ievent.qualifier := {};
- ievent.eventAddress := NIL; *)
- ievent.class := ie.rawkey;
-
- FOR i := 0 TO 3FH DO
- ievent.code := i;
- SYS.SETREG(0,con.RawKeyConvert(ievent,KeyMap[i],16,NIL));
- END;
-
- (*------ Decrunch: ------*)
-
- Decrunch;
-
- (*------ Init & Add 2nd Task: ------*)
-
- ShowTask.spLower := ShowStack;
- ShowTask.spUpper := SYS.VAL(e.APTR,SYS.VAL(LONGINT,ShowStack) + ShowStackSize);
- ShowTask.spReg := ShowTask.spUpper;
- ShowTask.node.type := e.task;
- ShowTask.node.name := SYS.ADR("muchmore show task");
- ShowTask.node.pri := Me.task.node.pri+1;
- (* $IF SmallData *)
- ShowTask.userData := SYS.REG(13); (* VarBase *)
- (* $END *)
-
- e.Forbid;
- e.AddTask(ShowTask,ShowProc,NIL);
- ShowTaskRunning := w;
- e.Permit;
-
- SYS.SETREG(0,e.Wait(mySig));
-
-
- (*------ Main Load / Display Loop: ------*)
-
- LOOP
- fg := 1; bg := 0; oldfg := fg; oldbg := bg; style := SHORTSET{};
- RQLen := -1; RQPos := -1;
- AnzLines := 1;
- LastLine := FirstLine;
- BottomLine := FirstLine;
- TopLine := FirstLine;
- TextLength := 0;
- ReadLength := 0;
- FindLine := NIL;
- FOR i := 0 TO 9 DO TextMarkers[i] := NIL END;
-
- FileLength := 0;
-
- IF ~stdin THEN
- MyLock := d.Lock(Name,d.sharedLock);
- IF MyLock # NIL THEN
- IF d.Examine(MyLock,FileInfo^) THEN FileLength := FileInfo.size END;
- d.UnLock(MyLock); MyLock := NIL;
- IF FileLength=0 THEN Request(LocStr(MSGEMPTY)^) END;
- END;
- END;
-
- (*------ Start displaying & Loading: ------*)
-
- NewDisp := w;
-
- e.Signal(ShowTask,showSig);
-
- REPEAT
- LoadLine := GetTextLine();
- IF LoadLine=NIL THEN
- IF ~stdin THEN d.OldClose(MyFile) END;
- MyFile := NIL;
- ELSE
- LoadLine.prev := LastLine;
- LastLine.next := LoadLine;
- LastLine := LoadLine;
- END;
- IF SignalNewData THEN e.Signal(ShowTask,showSig) END;
- UNTIL (MyFile=NIL) OR Done OR NewText;
- IF SignalAllRead THEN e.Signal(ShowTask,showSig) END;
- REPEAT
- SYS.SETREG(0,e.Wait(mySig));
- IF print THEN
- in := d.Open("NIL:",d.newFile);
- IF d.SystemTags(PStr,d.sysInput, SYS.VAL(e.APTR,in),
- d.sysOutput, NIL,
- d.sysAsynch, d.DOSTRUE,
- d.sysUserShell,d.DOSTRUE,
- u.done) = -1 THEN
- d.OldClose(in);
- ELSE
- Decrunched := f; INC(meInt);
- END;
- in := NIL;
- print := f;
- END;
- IF save THEN
- in := d.Open(Name,d.oldFile);
- IF in=NIL THEN I.DisplayBeep(NIL) ELSE
- ol.New(buffer,savesize);
- SYS.SETREG(0,d.Seek(in,savefrom,0));
- IF d.Read(in,buffer^,savesize)#savesize THEN
- I.DisplayBeep(NIL);
- d.OldClose(in); in := NIL;
- ELSE
- d.OldClose(in); in := NIL;
- IF copy THEN
- iff := NIL;
- LOOP
- IF ip.base=NIL THEN EXIT END;
- iff := ip.AllocIFF();
- IF iff=NIL THEN EXIT END;
- iff.stream := SYS.VAL(LONGINT,ip.OpenClipboard(0));
- IF iff.stream=NIL THEN EXIT END;
- ip.InitIFFasClip (iff);
- IF (ip.OpenIFF (iff, ip.write) = 0) &
- (ip.PushChunk(iff, SYS.VAL(LONGINT,"FTXT"), ip.idFORM, ip.sizeUnknown)=0) &
- (ip.PushChunk(iff, 0, SYS.VAL(LONGINT,"CHRS"), ip.sizeUnknown)=0) &
- (ip.WriteChunkBytes(iff,buffer^,savesize) = savesize) &
- (ip.PopChunk (iff)=0) &
- (ip.PopChunk (iff)=0) THEN
- END;
- EXIT;
- END;
- IF iff#NIL THEN
- ip.CloseIFF(iff);
- IF iff.stream#0 THEN ip.CloseClipboard (SYS.VAL(e.APTR,iff.stream)) END;
- ip.FreeIFF (iff);
- END;
- ELSE
- out := d.Open(WriteName,d.newFile);
- IF out=NIL THEN I.DisplayBeep(NIL) ELSE
- IF d.Write(out,buffer^,savesize)#savesize THEN I.DisplayBeep(NIL) END;
- d.OldClose(out); out := NIL;
- END;
- END;
- END;
- DISPOSE(buffer);
- END;
- save := f;
- END;
- IF Done THEN EXIT END;
- UNTIL NewText;
- IF MyFile # NIL THEN
- IF ~stdin THEN d.OldClose(MyFile) END;
- MyFile := NIL
- END;
- IF Decrunched & d.DeleteFile(Name) THEN END;
- Decrunched := f;
- DisposeLines();
- FirstLine^.next := NIL; NewText := f;
- Name := OldName;
- stdin := FALSE;
- REPEAT
- FileReq(Name);
- MyFile := d.Open(Name,d.oldFile);
- UNTIL MyFile # NIL;
- Decrunch;
- END; (* LOOP *)
-
- CLOSE
-
- IF Window # NIL THEN Window.userPort.sigTask := Me END;
- IF ShowTaskRunning THEN e.RemTask(ShowTask) END;
- IF console # NIL THEN e.CloseDevice(conreq) END;
- IF Window # NIL THEN I.CloseWindow(Window) END;
- IF Screen # NIL THEN I.OldCloseScreen(Screen) END;
- IF MyFont # NIL THEN g.CloseFont(MyFont) END;
- IF (MyFile#NIL) & ~stdin THEN d.OldClose(MyFile) END;
- IF in # NIL THEN d.OldClose(in) END;
- IF out # NIL THEN d.OldClose(out) END;
- IF Decrunched THEN SYS.SETREG(0,d.DeleteFile(Name)) END;
- IF xpk # NIL THEN e.CloseLibrary(xpk) END;
- IF asl # NIL THEN e.CloseLibrary(asl) END;
- IF diskFontBase# NIL THEN e.CloseLibrary(diskFontBase) END;
- IF iconBase # NIL THEN e.CloseLibrary(iconBase) END;
- IF mySigBit >= 0 THEN e.FreeSignal(mySigBit) END;
- IF catalog # NIL THEN loc.CloseCatalog(catalog); END;
- IF taskpri # oldpri THEN oldpri := e.SetTaskPri(Me,oldpri)END;
- OldDir := d.CurrentDir(OldDir);
-
- END MuchMore.
-
-